#!/usr/local/cpanel/3rdparty/bin/perl
package scripts::export_horde_calendars_to_ics;

# cpanel - scripts/export_horde_calendars_to_ics   Copyright 2022 cPanel, L.L.C.
#                                                           All rights reserved.
# copyright@cpanel.net                                         http://cpanel.net
# This code is subject to the cPanel license. Unauthorized copying is prohibited

use cPstrict;

use parent qw{Cpanel::HelpfulScript};

use Clone                                ();
use Cpanel::DAV::Principal               ();
use Cpanel::DAV::Backend::HordeCalendar  ();
use Cpanel::DAV::Backend::DB::Horde      ();
use Cpanel::Security::Authz              ();
use Cpanel::Slurper                      ();
use Cpanel::Umask                        ();
use Cwd                                  ();
use DateTime                             ();
use MIME::Base64                         ();
use PHP::Serialization                   ();
use Text::VCardFast                      ();
use Whostmgr::Email                      ();
use Cpanel::AccessIds::ReducedPrivileges ();

use constant _OPTIONS => ( 'out=s', 'user=s@' );

my %skipped = map { $_ => 1 } qw{
  alarm alarm_methods allday ar_id id start end baseid timezone
  recurcount recurdays recurenddate recurinterval recurtype resources
  exceptions
};

# kronolith/lib/Kronolith.php has the constants that this map duplicates in
# order to know what DB value corresponds to what status for certain fields.
my %event_status_map = (
    0 => 'NEEDS-ACTION',
    1 => 'TENTATIVE',
    2 => 'CONFIRMED',
    3 => 'CANCELLED',
    4 => 'FREE',
);
my %response_status_map = (
    1 => 'NEEDS-ACTION',
    2 => 'ACCEPTED',
    3 => 'DECLINED',
    4 => 'TENTATIVE',
);

# Horde/Date/Recurrence.php contains the related constants here.
my %recur_type_map = (
    0 => 'NONE',
    1 => 'DAILY',
    2 => 'WEEKLY',
    3 => 'MONTHLY',    # _DATE
    4 => 'MONTHLY',    # _WEEKDAY
    5 => 'YEARLY',     # _DATE
    6 => 'YEARLY',     # _DAY
    7 => 'YEARLY',     # _WEEKDAY
    8 => 'MONTHLY',    # _LAST_WEEKDAY
);

my %remapped = (
    'status'   => sub { return [ { 'name' => 'status',  'value' => $event_status_map{ $_[0] } } ] },
    'title'    => sub { return [ { 'name' => 'summary', 'value' => $_[0] } ] },
    'private'  => sub { return [ { 'name' => 'class',   'value' => ( $_[0] ? 'private' : 'public' ) } ] },
    'modified' => sub {
        my $d      = DateTime->from_epoch( 'epoch' => $_[0] );
        my $format = "yyyymmdd'T'hhmmss'Z'";
        return [ { 'name' => 'last-modified', 'value' => $d->format_cldr($format) } ];
    },
    'attendees' => sub {
        return if !$_[0];
        my $breakfast = PHP::Serialization::unserialize( $_[0] );
        my $cnt       = 0;
        if ( ref($breakfast) eq 'ARRAY' ) {
            $cnt = @{$breakfast};
        }
        else {
            $cnt = scalar keys %{$breakfast};
        }
        if ( $cnt < 1 ) {
            return [ { 'name' => 'attendee', 'value' => 'none', 'params' => { 'role' => ['REQ-PARTICIPANT'], 'partstat' => [''], 'rsvp' => [''] } } ];
        }
        return [
            map {
                my $key = $_;
                {
                    'name'   => 'attendee',
                    'value'  => "mailto:$key",
                    'params' => {
                        'role'     => ['REQ-PARTICIPANT'],                                          # Horde has no conception of non-participants
                        'partstat' => [ $response_status_map{ $breakfast->{$key}{'response'} } ],
                        'rsvp'     => [ $breakfast->{$key}{'attendance'} ? 'true' : 'false' ],
                    },
                }
            } keys(%$breakfast)
        ];
    },
    'creator_id' => sub {
        return [ { 'name' => 'organizer', 'value' => "mailto:$_[0]", 'params' => { 'cn' => $_[0] } } ];
    },
);

# I'm only doing package level scoping here for ease of testing.
our %extra_items = (
    'transp'  => sub { return [ { 'name' => 'transp', 'value' => 'OPAQUE' } ] },
    'created' => sub {
        my $uid  = $_[0]->{'event_uid'};
        my $date = substr( $uid, 0, 14 );

        # Reject invalid dates... Only horde's events have this reliably set.
        # We can do a "naive" numeric check here because it isnt' decimal math.
        if ( length $date < 8 || $date !~ m/^\d+$/ ) {
            $date = '00000000T000000Z';
        }
        else {
            $date = substr( $date, 0, 8 ) . 'T' . substr( $date, 8 ) . 'Z';
        }
        return [ { 'name' => 'created', 'value' => $date } ];
    },    # Creation date is first part of event UID
    'dtstart' => sub {
        my ($data) = @_;
        my $val = $data->{'event_start'};
        $val =~ s/[-:]*//g;
        my $params = {};
        if ( $data->{'event_allday'} ) {
            $params->{'value'} = 'DATE';
            $val = substr( $val, 0, index( $val, " " ) );
        }
        else {
            $val =~ tr/ /T/;
        }
        return [ { 'name' => 'dtstart', 'value' => $val, 'params' => $params } ];
    },
    'dtend' => sub {
        my ($data) = @_;
        my $val = $data->{'event_end'};
        $val =~ s/[-:]*//g;
        my $params = {};
        if ( $data->{'event_allday'} ) {
            $params->{'value'} = 'DATE';
            $val = substr( $val, 0, index( $val, " " ) );
        }
        else {
            $val =~ tr/ /T/;
        }
        return [ { 'name' => 'dtend', 'value' => $val, 'params' => $params } ];
    },

    # No idea where it is getting dtstamp
    #'dtstamp' => sub { return [{ 'name' => 'dtstamp', 'value' => '' }] },
    'rrule' => sub {    # https://datatracker.ietf.org/doc/html/rfc2445#section-4.3.10
        my ($evt) = @_;
        return [] if !$evt->{'event_recurtype'};
        $evt->{'event_recurinterval'} //= 0;
        $evt->{'event_recurdays'}     //= 0;
        $evt->{'event_recurcount'}    //= 0;
        $evt->{'event_recurenddate'}  //= '99991231';
        my $rrval = 'freq=' . $recur_type_map{ $evt->{'event_recurtype'} } . ";";                                                                                    # FREQ is required
        $rrval .= 'interval=' . $evt->{'event_recurinterval'} . ";"             if $evt->{'event_recurinterval'} != 0;                                               # INTERVAL is optional
        $rrval .= 'byday=' . recur_days_calc( $evt->{'event_recurdays'} ) . ";" if $evt->{'event_recurdays'} != 0;                                                   # BYxxx rules are optional
        $rrval .= 'count=' . $evt->{'event_recurcount'} . ";"                   if $evt->{'event_recurcount'} != 0;                                                  # COUNT is optional
        $rrval .= 'until=' . $evt->{'event_recurenddate'} . ";"                 if $evt->{'event_recurcount'} == 0 && $evt->{'event_recurenddate'} ne '99991231';    # UNTIL is mutually exclusive with COUNT
        return [ { 'name' => 'rrule', 'value' => uc($rrval) } ];
    },

    # The two below have to be part of their own vcard. Datastructure
    # looks a bit strange as such ;_;
    #'valarm'  => sub { return [{ 'name' => 'valarm', 'value' => '' }] },
    #'vtimezone' => sub { return [{ 'name' => 'vtimezone', 'value' => '' }] },
);

__PACKAGE__->new(@ARGV)->run() if !caller;

sub recur_days_calc ($hordedays) {
    my @icaldays;
    do {
        if ( $hordedays - 64 >= 0 ) { unshift @icaldays, ('SA'); $hordedays -= 64 }
        if ( $hordedays - 32 >= 0 ) { unshift @icaldays, ('FR'); $hordedays -= 32 }
        if ( $hordedays - 16 >= 0 ) { unshift @icaldays, ('TH'); $hordedays -= 16 }
        if ( $hordedays - 8 >= 0 )  { unshift @icaldays, ('WE'); $hordedays -= 8 }
        if ( $hordedays - 4 >= 0 )  { unshift @icaldays, ('TU'); $hordedays -= 4 }
        if ( $hordedays - 2 >= 0 )  { unshift @icaldays, ('MO'); $hordedays -= 2 }
        if ( $hordedays - 1 >= 0 )  { unshift @icaldays, ('SU'); $hordedays -= 1 }
    } while $hordedays > 0;
    return join ',', @icaldays;
}

sub run {
    my ($self) = @_;

    my $users  = $self->getopt('user');
    my $outdir = $self->getopt('out');
    my $abs    = Cwd::abs_path($outdir) if $outdir;
    $outdir = $abs ? $abs : $outdir;    # At least we tried

    die $self->help() if !defined $users || ref $users ne 'ARRAY';

    # The below check which is being nooped out is understandable in the
    # context of "a user wants to write to the DB". However, in this case we
    # are not going to write, instead only reading from the users' DBs in bulk.
    {
        no warnings qw{redefine};
        local *Cpanel::Security::Authz::verify_not_root = sub { };

        foreach my $user (@$users) {
            my $chalmers = Cpanel::DAV::Principal->get_principal($user);
            my $dbh      = Cpanel::DAV::Backend::DB::Horde::get_dbh( $chalmers->{'name'} );

            my $pops = Whostmgr::Email::list_pops_for($user);
            unshift @$pops, $user;

            foreach my $mailuser (@$pops) {
                $chalmers = Cpanel::DAV::Principal->get_principal($mailuser) if $mailuser ne $user;
                my $cals = Cpanel::DAV::Backend::HordeCalendar::get_calendars( $chalmers, $dbh );
                my $mailuser_output;

                foreach my $cal ( @{ $cals->{data} } ) {
                    my $ics_blob = "BEGIN:VCALENDAR\nVERSION:2.0\nPRODID:-//cPanel Horde Calendar Exporter//export_horde_calendars_to_ics//EN\nX-WR-CALNAME:$cal->{'name'}\n";
                    my $uid      = $cal->{'uid'};
                    my $query    = 'SELECT * FROM kronolith_events WHERE calendar_id = ?';
                    my ( $matches, $exception ) = Cpanel::DAV::Backend::DB::Horde::select_all( $dbh, $query, $uid );
                    foreach my $event (@$matches) {
                        my $evt_hr = {
                            'objects' => [
                                {
                                    'type'       => 'vevent',
                                    'properties' => {},
                                }
                            ],
                        };
                        foreach my $prop ( keys(%$event) ) {
                            my $prop_short = substr( $prop, 6 );    # event_
                            next if !defined $event->{$prop} || $skipped{$prop_short};
                            if ( $remapped{$prop_short} ) {
                                $evt_hr->{'objects'}[0]{'properties'}{$prop_short} = $remapped{$prop_short}->( $event->{$prop} );
                            }
                            else {
                                # CPANEL-42420: It is HIGHly likely that the
                                # description field has newlines/blank lines.
                                # These unfortunately do not pass any known
                                # parser's evaluation based on the spec, so
                                # trim it.
                                $evt_hr->{'objects'}[0]{'properties'}{$prop_short} = [
                                    {
                                        'name'  => $prop_short,
                                        'value' => _trim( $event->{$prop} ),
                                    },
                                ];
                            }
                        }
                        foreach my $item ( keys(%extra_items) ) {
                            $evt_hr->{'objects'}[0]{'properties'}{$item} = $extra_items{$item}->($event);
                        }

                        # Reject events with nonsense values for DTSTART/DTEND (CPANEL-42509)
                        next if grep { $evt_hr->{'objects'}[0]{'properties'}{$_} eq '00000000T000000' } qw{dtstart dtend};

                        my $vevent = Text::VCardFast::hash2vcard($evt_hr);
                        if ( $event->{'event_alarm'} ) {
                            my $valarm = "BEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:$event->{'event_title'}\nTRIGGER;VALUE=DURATION:-PT$event->{'event_alarm'}M\nEND:VALARM\n";
                            $vevent =~ s/END:VEVENT/${valarm}END:VEVENT/;
                        }

                        # roundcube 1.5 does not comply with latest rfc so we create a crafted version which is compatible
                        my $rc_sanitized;
                        my $check_following = 0;
                        foreach my $line ( split( /([\r\n])/, $vevent ) ) {
                            chomp $line;
                            next if !$line;
                            if ( $line =~ m/^RRULE/ || ( $check_following && $line =~ m/^\s/ ) ) {    # Currently limited to just the RRULE lines, to avoid issues with description and such
                                $line =~ s/\\\;/\;/g;
                                $line =~ s/\\\,/\,/g;

                                if ( $line =~ m/^\s/ || $line =~ m/^RRULE/ ) {
                                    $check_following++;
                                }
                                else {
                                    $check_following = 0;
                                }
                            }
                            else {
                                $check_following = 0;
                            }
                            $rc_sanitized .= $line . "\n";
                        }

                        $ics_blob .= $rc_sanitized;
                    }
                    $ics_blob        .= "END:VCALENDAR\n";
                    $mailuser_output .= $ics_blob;
                }

                if ($outdir) {

                    # HB-6674: If outdir looks like cpanelroundcube's home,
                    # Write it for that user instead.
                    $user = 'cpanelroundcube' if index( $outdir, "/var/cpanel/userhomes/cpanelroundcube" ) == 0;
                    Cpanel::AccessIds::ReducedPrivileges::call_as_user(
                        $user,
                        sub {
                            if ( !-d $outdir ) {
                                my $mask = Cpanel::Umask->new(0027);
                                mkdir("$outdir") or die "Can't create outdir '$outdir': $!";
                            }

                            # Dies on fail, so don't guard it
                            Cpanel::Slurper::write( "$outdir/$mailuser.ics", $mailuser_output, 0644 );
                        }
                    );
                }
                else {
                    print $mailuser_output, "\n";
                }

            }
        }
    }
    return 0;
}

sub _trim ($text) {
    return "" if !defined $text;
    $text =~ s/\s{2,}//mg;
    return $text;
}

=head1 USAGE

    /usr/local/cpanel/scripts/export_horde_calendars_to_ics --out ~/dump_dir --user 'john_doe' --user 'john_doe2' ...

This script will export Horde calendars for the specified cPanel user(s) to the
specified outdir (or to STDOUT if none is specified).

=head2 OPTIONS

--user: cPanel user(s) whose Horde calendar should be exported. Any mail
users associated with the account will also be exported.

--out: Directory to which the output should be sent. Each mail user's calendar
is exported to '$MAILUSER.ics' file in the specified directory. If
the specified directory does not exist, the script will attempt to create it.
When not specified, output will be sent to STDOUT, with calendars separated
by two new lines each.

=cut

1;