1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Time::Local;
7use Time::localtime;
8use Getopt::Long qw(:config bundling);
9use HTTP::Request;
10use LWP::UserAgent;
11use Math::BigInt;
12use Digest::MD5 qw(md5_hex);
13use MIME::QuotedPrint;
14use MIME::Base64;
15use Net::LDAP;
16use Time::HiRes qw (gettimeofday tv_interval);
17
18use constant {
19    QUOTED_PRINTABLE   => 'auto',
20         # 0 : never decode data
21         # 1 : always decode data
22         # auto : try to guess from the file headers
23
24    OWNER => undef,
25	 # undef : use event organizer as the owner
26	 # <username> : force owner to be username
27
28    DUPLICATES => 'update',
29         # create : create a new entry if the UID already exists
30         # ignore : don't create the event if the UID already exists
31         # update : update the entry with the same UID (if deleted, stays deleted)
32         # replace : if the entry exists and was deleted, resurect it
33    RECURRENT => 0,
34         # smart : group new events with same UID as one recurrent event
35
36    LDAP_HOST => 'ldap://ldap.foobar.edu',
37    LDAP_BIND_DN => 'uid=sogo,ou=applications,dc=foobar,dc=edu',
38    LDAP_BIND_PW => 'PASSWORD',
39    LDAP_BASE => 'ou=people,dc=foobar,dc=edu',
40    LDAP_USERNAME => 'uid',
41    LDAP_EMAIL => 'mail',
42    LDAP_EMAIL_FILTER => '(|(mail=%s)(mailAlternateAddress=%s))',
43
44    FORCE_USERNAME => undef,
45    FORCE_CLOSE => 0,
46    DRYRUN => 0,
47    DEBUG => 1
48};
49
50$| = 1;
51
52# Global variables
53my $file;
54my ($username, $email);
55my $url;
56my ($host, $port, $authusername, $password);
57my $ua;
58my $ldap;
59my %duplicatedUID = ();
60my $pwdhash;
61
62my $timezone = <<_EOF;
63
64BEGIN:VTIMEZONE
65TZID:/inverse.ca/20091015_1/America/New_York
66X-LIC-LOCATION:America/New_York
67BEGIN:DAYLIGHT
68TZOFFSETFROM:-0500
69TZOFFSETTO:-0400
70TZNAME:EDT
71DTSTART:19700308T020000
72RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=2SU
73END:DAYLIGHT
74BEGIN:STANDARD
75TZOFFSETFROM:-0400
76TZOFFSETTO:-0500
77TZNAME:EST
78DTSTART:19701101T020000
79RRULE:FREQ=YEARLY;BYMONTH=11;BYDAY=1SU
80END:STANDARD
81END:VTIMEZONE
82_EOF
83
84sub usage
85{
86    my $msg = shift;
87
88    print "$msg\n" if ($msg);
89    print "Usage: $0 <url> <username> <type> <filename>\n";
90    print "  <url>       must have the form http[s]://[superuser]:[password]\@hostname\n";
91    print "              The full URL will be build using the username.\n";
92    print "  <type>      must be 'events', 'tasks' or 'rights' to specify the type of data\n";
93    print "  <filename>  must have the form <type>.<username>\n";
94    print "\n";
95}
96
97sub getEmailByUsername
98{
99    my ($ldap, $username) = @_;
100
101    my $results = $ldap->search(base => LDAP_BASE,
102				filter => '('.LDAP_USERNAME.'='.$username.')',
103				attrs => [(LDAP_EMAIL)]);
104    if ($results->count != 1) {
105	print "Unexpected number of LDAP entries (",$results->count,") for $username\n";
106	return 0;
107    }
108    my $entry = $results->entry(0);
109
110    return $entry->get_value(LDAP_EMAIL);
111}
112
113my %emailToUserName;
114
115sub getUsernameByEmail
116{
117    my ($ldap, $email) = @_;
118
119    if (!defined($emailToUserName{$email})) {
120	my $results = $ldap->search(base => LDAP_BASE,
121				    filter => sprintf(LDAP_EMAIL_FILTER, $email, $email),
122				    attrs => [(LDAP_USERNAME)]);
123	if ($results->count != 1) {
124	    print "Unexpected number of entries return for $email\n";
125	    return 0;
126	}
127	my $entry = $results->entry(0);
128	$emailToUserName{$email} = $entry->get_value(LDAP_USERNAME);
129    }
130
131    return $emailToUserName{$email};
132}
133
134sub calendarUrl
135{
136    my $username = $_[0];
137    my $uid = $_[1] || "";
138
139    return "$url/SOGo/dav/$username/Calendar/personal/$uid";
140}
141
142sub httpRequest
143{
144    my ($request, $uid) = @_;
145
146    my $result = 1;
147    my $i;
148    for ($i = 0; $i < 30; $i++) {
149	my $response = $ua->request($request);
150	if ($response->is_success) {
151	    print $request->method, " $uid:\t", $response->status_line, "\n";
152	    last;
153	}
154	else {
155	    print STDERR "ERR ", $request->method, " $uid:\t", $response->status_line, "\n";
156	    if ($response->code == 500) {
157		print STDERR "INFO sleeping 2 secs\n";
158		sleep(2);
159	    }
160	    else {
161		$result = 0;
162		last;
163	    }
164	}
165    }
166
167    if ($i == 30) {
168	print STDERR "ERR ", $request->method, " $uid:\tCan't reach server for the past 60 secs - exiting.\n";
169	exit(-4);
170    }
171
172    return $result;
173}
174
175sub userCalendarExists
176{
177    my ($username) = @_;
178    my $result = 0;
179
180    my $propfind = '<?xml version="1.0" encoding="utf-8"?><D:propfind xmlns:D="DAV:"><D:allprop/></D:propfind>';
181    my $request = HTTP::Request->new();
182    $request->method('PROPFIND');
183    $request->uri(&calendarUrl($username));
184    $request->header('Content-Type' => 'text/xml; charset=utf8');
185    $request->header('Content-Length' => length($propfind));
186    $request->header('Depth' => 0);
187    $request->header('Authorization' => "Basic $pwdhash");
188    $request->content($propfind);
189
190    $result = &httpRequest($request, $username);
191
192    return $result;
193}
194
195sub searchByUid
196{
197    my ($username, $uid) = @_;
198    my $result = 0;
199
200    my $request = HTTP::Request->new();
201    $request->method('GET');
202    $request->uri(&calendarUrl($username, $uid));
203
204    $result = &httpRequest($request, $uid);
205
206    return $result;
207}
208
209sub deleteEvent()
210{
211    my ($username, $uid) = @_;
212    my $result = 0;
213
214    return $result if (DRYRUN);
215
216    my $request = HTTP::Request->new();
217    $request->method('DELETE');
218    $request->uri(&calendarUrl($username, $uid));
219
220    $result = &httpRequest($request, $uid);
221
222    return $result;
223}
224
225sub putEvent(\%)
226{
227    my (%vevent) = %{(shift)};
228    my $count = shift;
229
230    my $uid = $vevent{'uid'};
231
232    # decode data
233    $vevent{'data'} =~ s/\r//g;
234    $vevent{'data'} =~ s/([^=])\n /$1/g;
235    if (QUOTED_PRINTABLE eq '1' ||
236	(QUOTED_PRINTABLE eq 'auto' && $vevent{'encoding'} && $vevent{'encoding'} =~ m/quoted-printable/)) {
237	$vevent{'data'} = decode_qp($vevent{'data'});
238    }
239
240    # for "notes", we need to add one day to the DTEND
241    my $oracleEventType;
242    if ($vevent{'data'} =~ /X-ORACLE-EVENTTYPE:(.*)/) {
243	$oracleEventType = $1;
244    } else {
245	$oracleEventType = "unknown";
246    }
247    if ($oracleEventType eq 'DAILY NOTE') {
248#	if ($vevent{'data'} =~ /DTEND;VALUE=DATE:(\d{4})(\d{2})(\d{2})/) {
249#	    my ($mday,$mon,$year) = ($3, $2, $1);
250#	    my $seconds = timelocal(0, 0, 0, $mday, $mon - 1, $year - 1900);
251#	    $seconds += 86400;
252#	    # we specify "CORE::" because we expect an array instead of a
253#	    # magical hash
254#	    my @newLocalTime = CORE::localtime($seconds);
255#	    $mday = $newLocalTime[3];
256#	    $mon = $newLocalTime[4] + 1;
257#	    $year = $newLocalTime[5] + 1900;
258#	    my $newEndDate = sprintf("%.4d%.2d%.2d", $year, $mon, $mday);
259#	    my $dtEndPrefix = "DTEND;VALUE=DATE:";
260#	    my $dtEndIndex = index $vevent{'data'}, $dtEndPrefix;
261#	    if ($dtEndIndex > -1) {
262#		my $partLength = $dtEndIndex + length($dtEndPrefix);
263#		$vevent{'data'} = sprintf("%s%s%s",
264#					  substr($vevent{'data'}, 0, $partLength),
265#					  $newEndDate,
266#					  substr($vevent{'data'}, $partLength + 8));
267#	    }
268#	}
269
270	# we set a timezone for dates in all day events to ensure that SOGo
271	# does not put them in UTC
272	$vevent{'data'} =~ s@BEGIN:VEVENT@${timezone}BEGIN:VEVENT@;
273	$vevent{'data'} =~ s@DTSTART;VALUE=DATE:@DTSTART;VALUE=DATE;TZID=/inverse.ca/20091015_1/America/New_York:@;
274	$vevent{'data'} =~ s@DTEND;VALUE=DATE:@DTEND;VALUE=DATE;TZID=/inverse.ca/20091015_1/America/New_York:@;
275    }
276
277    # parse attendees
278    my $hasAttendees = 0;
279    while ($vevent{'data'} =~ m/ATTENDEE;(.+)$/gm) {
280	my @parameters = split(';', $1);
281	$vevent{'attendees'} = [] unless ($vevent{'attendees'});
282	my %attendee = ();
283	foreach (@parameters) {
284	    #print $_,"\n";
285	    if (m/^(\S+)=(.+)$/) {
286		print "\t$1 => $2\n";
287		$attendee{$1} = $2;
288		if ($1 eq 'CN' && $2 =~ m/mailto:(\S+)$/) {
289		    $attendee{'CN'} = $1;
290		    $attendee{'username'} = &getUsernameByEmail($ldap, $1);
291		    $hasAttendees = 1 if ($1 ne $email); # Attendee is not the owner
292		}
293	    }
294	}
295	push(@{$vevent{'attendees'}}, \%attendee);
296    }
297
298    # handle duplicated UID within file
299    if ($duplicatedUID{$uid}) {
300	$uid .= $duplicatedUID{$uid};
301	$duplicatedUID{$vevent{'uid'}}++;
302    }
303    else {
304	$duplicatedUID{$uid} = 1;
305    }
306
307    unless (DUPLICATES eq 'update') {
308	if (&searchByUid($username, $uid)) {
309	    print STDERR "Event with UID '$uid' already exists\n";
310	    return 0 if (DUPLICATES eq 'ignore');
311
312	    if (DUPLICATES eq 'replace') {
313		&deleteEvent($username, $uid);
314	    }
315#	    elsif ($hasAttendees) {
316#		print STDERR "UID collision (",$uid,") for an event with attendee(s); ignoring it\n";
317#		return 0;
318#	    }
319	    else {
320		# Make sure UID is unique (DUPLICATES eq 'create')
321		my $i = ($duplicatedUID{$vevent{'uid'}})?$duplicatedUID{$vevent{'uid'}}:1;
322		for ($uid .= $i;
323		     &searchByUid($username, $uid) == 1;
324		     print STDERR "Event with UID '$uid' already exists\n",
325		     $uid = $vevent{'uid'} . $i,
326		     $i++)
327		{};
328		$duplicatedUID{$vevent{'uid'}} = $i + 1;
329	    }
330	}
331    }
332
333    # If UID already exists, change it in the VEVENT
334    if ($uid ne $vevent{'uid'}) {
335	$vevent{'data'} =~ s/^UID:\S+$/UID:$uid/m;
336    }
337
338    if ($vevent{'data'} =~ m/^SUMMARY:[;\s]*$/m) {
339	$vevent{'data'} =~ s#^(BEGIN:VEVENT)#$1\nSUMMARY: (untitled event)#m;
340    }
341
342    if ($vevent{'recurrent'}) {
343	$vevent{'data'} =~ s#^(BEGIN:VEVENT)#$1\nRRULE:FREQ=DAILY;COUNT=1;INTERVAL=1#m;
344    }
345
346    $vevent{'data'} =
347	"BEGIN:VCALENDAR\n" .
348	"VERSION:2.0\n" .
349	"PRODID:Oracle/Oracle Calendar Server 10.1.2.3.3\n" .
350	$vevent{'data'} .
351	"END:VCALENDAR";
352
353    if (DEBUG) {
354	foreach my $key (keys %vevent) {
355	    if (ref($vevent{$key}) eq 'ARRAY') {
356		print "$key =>\n";
357		foreach (@{$vevent{$key}}) {
358		    my %hash = %{$_};
359		    print " =>";
360		    foreach (keys %hash) {
361			print "\t$_ => $hash{$_}\n";
362		    }
363		}
364	    }
365	    else {
366		print "$key = \n\t", $vevent{$key},"\n";# unless ($key eq 'data');
367	    }
368	}
369    }
370    print "PUT ",&calendarUrl($username, $uid),"\n";
371
372    return 0 if (DRYRUN);
373
374    my $request = HTTP::Request->new();
375
376    $request->method('PUT');
377    $request->uri(&calendarUrl($username, $uid));
378
379    $request->header('Authorization' => "Basic $pwdhash");
380
381    #$request->header('Accept-Charset' => 'ISO-8859-1,utf-8;q=0.7,*;q=0.7');
382    #$request->header('Accept-Language' => 'fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3');
383    #$request->header('Content-Type' => 'text/plain; charset=utf-8');
384    $request->header('Content-Type' => 'text/calendar; charset=utf-8');
385    $request->header('Content-Length' => length($vevent{'data'}));
386    $request->header('x-sogo-mode' => 'M');
387    #$request->header('Connection' => 'TE');
388    if (FORCE_CLOSE && ($count % FORCE_CLOSE) == 0) {
389	print "Force connection close (no keepalive)\n";
390	$request->header('Connection' => 'close');
391    }
392    #$request->header('TE' => 'trailers');
393    #$request->header('Depth' => 1);
394    #$request->header('Accept-Charset' => 'utf-8');
395    #$request->header('Accept' => 'text/plain');
396    $request->content($vevent{'data'});
397
398
399    return &httpRequest($request, $uid);
400#    my $i;
401#    for ($i = 0; $i < 30; $i++) {
402#	my $response = $ua->request($request);
403#	if ($response->is_success) {
404#	    print "PUT $uid:\t", $response->status_line, "\n";
405#	    last;
406#	}
407#	else {
408#	    print STDERR "ERR PUT $uid:\t", $response->status_line, "\n";
409#	    sleep(2);
410#	}
411#    }
412#
413#    if ($i == 30) {
414#	print STDERR "ERR PUT $uid:\tCan't reach server for the past 60 secs - exiting.\n";
415#	exit(-4);
416#    }
417}
418
419sub parseEventsFile
420{
421    my $file = shift;
422
423    my %vevent = ();
424    my %last_vevent = ();
425# data
426# uid
427# encoding
428# organizer
429# username
430# recurrent
431
432    my $count = 0;
433    my $count_created = 0;
434    my $bytes_count = 0;
435    my $elapsed_time = [gettimeofday];
436
437    while (my $line = <CAL>) {
438	$line =~ s/\r$//; # remove dos linebreaks
439	if ($line =~ m/^BEGIN:VEVENT$/) {
440	    $vevent{'data'} = $line;
441	}
442	elsif ($line =~ m/^END:VEVENT$/) {
443	    $vevent{'data'} .= $line;
444	    #if ($vevent{'organizer'} eq $email) {
445	    $count++;
446	    $bytes_count += length($vevent{'data'});
447
448	    if (RECURRENT eq 'smart') {
449		if (%last_vevent) {
450		    if ($last_vevent{'uid'} eq $vevent{'uid'}) {
451			$last_vevent{'data'} .= $vevent{'data'};
452			$last_vevent{'recurrent'} = 1;
453			if ($last_vevent{'username'} ne $vevent{'username'}) {
454			    print "ERR: Matching UID with different organizers!\n";
455			}
456		    }
457		    else {
458			$count_created += &putEvent(\%last_vevent, $count);
459			%last_vevent = %vevent;
460		    }
461		}
462		else {
463		    %last_vevent = %vevent;
464		}
465	    }
466#	    elsif ($vevent{'rdate'}) {
467#	      # Ignore event with RDATE attributes -- they are not currently
468#	      # supported in SOGo (web)
469#	      $vevent{'rdate'} = undef;
470#	      print "Event with RDATE -- ignored\n";
471#	    }
472	    else {
473		$count_created += &putEvent(\%vevent, $count);
474	    }
475	    #$last_data = $vevent{'data'};
476	    #last;
477	    #}
478	    #else {
479	    #print $vevent{'uid'},": $email ($username) NOT organizer ",$vevent{'organizer'}," (",$vevent{'username'},"); verify event\n";
480	    #}
481	    $vevent{'data'} = undef;
482	    #last;
483	}
484	elsif ($vevent{'data'}) {
485	    if ($line !~ m/^$/
486		&& $line !~ m/^RECURRENCE-ID/
487		&& $line !~ m/^RDATE:/) {
488		if ($line =~ m/UID:\s*(\S+)$/) {
489		    $vevent{'uid'} = $1;
490		    $vevent{'uid'} =~ s/[#&\/]/-/g;
491		    $vevent{'uid'} =~ s/\.//g;
492		    $line =~ s/^(UID:).*$/$1$vevent{'uid'}/;
493		}
494		elsif ($line =~ m/^ORGANIZER:(?:mailto:)?(\S+)$/) {
495		    $vevent{'organizer'} = $1;
496		    $vevent{'username'} = &getUsernameByEmail($ldap, $1);
497		}
498#		elsif ($line =~ m/^RDATE:/) {
499#		  $vevent{'rdate'} = 1;
500#		}
501		$vevent{'data'} .= $line unless ();
502	    }
503	    else {
504		print "ignored: '$line'\n";
505	    }
506	}
507	elsif ($line =~ m/Content-Transfer-Encoding: (\S+)$/) {
508	    $vevent{'encoding'} = $1;
509	}
510    }
511
512    if (%last_vevent) {
513	$count_created += &putEvent(\%last_vevent, $count);
514    }
515
516    printf "\nParsed %i events, %i new: %.1f KB in %.1f seconds\n",
517	$count, $count_created, ($bytes_count/1024), tv_interval($elapsed_time);
518
519    return 1;
520}
521
522sub gmtTime {
523  my $time = localtime(shift);
524  #my ($second,$minute,$hour,$dayofmonth,$month,$year,$weekday,$dayofyear,$isdst) = localtime($time);
525
526  #$year  += 1900;
527  #$month++;
528  #$hour -= $isdst;
529
530  return sprintf("%04d%02d%02dT%02d%02d%02dZ",
531		 $time->year+1900,
532		 $time->mon+1,
533		 $time->mday,
534		 $time->hour-$time->isdst,
535		 $time->min,
536		 $time->isdst);
537}
538
539sub putTask(\%) {
540  my (%task) = %{(shift)};
541  my $count = shift;
542  my $bytes_count_ref = shift;
543
544  return 0 unless ($task{'summary'});
545
546  my $now = &gmtTime(time);
547  my $uid = md5_hex(%task);
548  my $data = <<'VCAL';
549BEGIN:VCALENDAR
550VERSION:2.0
551PRODID:-//Inverse inc.//SOGo 0.9//EN
552BEGIN:VTODO
553UID:%s
554SUMMARY:%s
555LOCATION:
556VCAL
557
558  $data = sprintf($data, uc($uid), $task{'summary'});
559  $data .= "PRIORITY:" . $task{'priority'} . "\n" if ($task{'priority'});
560  $data .= "CREATED:$now\n";
561  $data .= "DTSTAMP:$now\n";
562  $data .= "LAST-MODIFIED:$now\n";
563  $data .= "DTSTART:" . &gmtTime($task{'start'}) . "\n" if ($task{'start'});
564  $data .= "DUE:" . &gmtTime($task{'end'}) . "\n" if ($task{'end'});
565  if (defined($task{'completion'})) {
566    if (scalar($task{'completion'}) < 100) {
567      $data .= "STATUS:IN-PROCESS\n";
568    }
569    else {
570      $data .= "STATUS:COMPLETED\n";
571    }
572    $data .= "PERCENT-COMPLETE:" . $task{'completion'} . "\n";
573  }
574  $data .= "DESCRIPTION:" . join("\\r\\n", @{$task{'description'}}) . "\n" if ($task{'description'});
575  $data .= "END:VTODO\n";
576  $data .= "END:VCALENDAR\n";
577
578  $$bytes_count_ref += length($data);
579
580  print $data if (DEBUG);
581  print "PUT ",&calendarUrl($username, $uid),"\n";
582
583  return 0 if (DRYRUN);
584
585  my $request = HTTP::Request->new();
586
587  $request->method('PUT');
588  $request->uri(&calendarUrl($username, $uid));
589  $request->header('Authorization' => "Basic $pwdhash");
590  $request->header('Content-Type' => 'text/calendar; charset=utf-8');
591  $request->header('Content-Length' => length($data));
592  $request->header('x-sogo-mode' => 'M');
593  if (FORCE_CLOSE && ($count % FORCE_CLOSE) == 0) {
594    print "Force connection close (no keepalive)\n";
595    $request->header('Connection' => 'close');
596  }
597  $request->content($data);
598
599  return &httpRequest($request, $uid);
600}
601
602sub parseTasksFile {
603# S 9265740
604# D 9266220
605# T task august 13th
606# R 1
607# L 100
608# M bar foo
609# W bar foo
610# C task august 13th 2008
611# C line 2 description
612# C line 3
613# O
614
615# BEGIN:VCALENDAR
616# VERSION:2.0
617# PRODID:-//Inverse inc.//SOGo 0.9//EN
618# BEGIN:VTODO
619# UID:26A-4979F880-1-B72F03D0
620# SUMMARY:this is a task
621# LOCATION:there
622# PRIORITY:1
623# STATUS:IN-PROCESS
624# CREATED:20090123T170443Z
625# DTSTAMP:20090123T170443Z
626# LAST-MODIFIED:20090123T170443Z
627# DTSTART:20090123T171500Z
628# DUE:20090124T181500Z
629# PERCENT-COMPLETE:40
630# DESCRIPTION:foo
631# END:VTODO
632# END:VCALENDAR
633
634  #my $file = $_[0];
635  my $count = 0;
636  my $count_created = 0;
637  my $bytes_count = 0;
638  my $elapsed_time = [gettimeofday];
639  my %task = ();
640  # Start and due times are computed in minutes since since Jan 1 1991
641  my $basetime = timelocal(0, 0, 0, 1, 0, 91);
642#   my $tm = localtime($basetime);
643#   printf("Base date: %04d/%02d/%02d %02d:%02d:%02d\n",
644# 	 $tm->year+1900, $tm->mon+1, $tm->mday,
645# 	 $tm->hour, $tm->min, $tm->sec);
646
647#   open (my $tasksfile, $file)
648#     or die "Cannot open tasks file '$file'";
649
650#   while ($line = <$tasksfile>) {
651  while (my $line = <CAL>) {
652    #$line =~ s/\n$//;
653    chomp $line;
654    if ($line =~ m/^O/) {
655      if (%task) {
656	$count++;
657	$count_created += &putTask(\%task, $count, \$bytes_count);
658	%task = ();
659      }
660    }
661    elsif ($line =~ m/^T (.+)/) {
662      $task{'summary'} = $1;
663    }
664    elsif ($line =~ m/^S (\d+)/ && $1) {
665      $task{'start'} = $1*60 + $basetime;
666    }
667    elsif ($line =~ m/^D (\d+)/ && $1) {
668      # End time (number of minutes since Jan 1 1991)
669      $task{'end'} = $1*60 + $basetime;
670#       $tm = localtime($task{'end'});
671#       printf("End date: %04d/%02d/%02d %02d:%02d:%02d\n",
672# 	     $tm->year+1900, $tm->mon+1, $tm->mday,
673# 	     $tm->hour, $tm->min, $tm->sec);
674    }
675    elsif ($line =~ m/^R (\w+)/) {
676      $task{'priority'} = $1;
677    }
678    elsif ($line =~ m/^L (\w+)/) {
679      $task{'completion'} = $1;
680    }
681    elsif ($line =~ m/^C (.+)/) {
682      $task{'description'} = () unless ($task{'description'});
683      push(@{$task{'description'}}, $1);
684    }
685  }
686
687  #close ($tasksfile);
688  close (CAL);
689
690  printf "\nParsed %i tasks, %i new: %.1f KB in %.1f seconds\n",
691    $count, $count_created, ($bytes_count/1024), tv_interval($elapsed_time);
692
693  return 1;
694}
695
696sub parseRightsFile
697{
698    my $file = $_[0];
699
700    open (my $rightsfile, $file)
701      or die "Cannot open rights file '$file'";
702
703    my $line = <$rightsfile>;
704    $line =~ s/\n$//;
705#line:---procuration, username, foo.bar@foo.edu
706    my $user;
707    if ($line =~ m@^\-\-\-procuration, ([^,]+),@) {
708	$user = $1;
709	print "rights for user's calendar: $user\n";
710    }
711    else {
712	die "Could not parse procuration line: $line";
713    }
714
715    my $next = 0; # 0 = Grantee, 1 = Designate right
716    my $grantee;
717    my $rights;
718
719    while ($line = <$rightsfile>) {
720	$line =~ s/\n$//;
721	if ($next == 0) {
722	    if ($line =~ m@^Grantee:\ S=[^/]+/G=[^/]+/UID=([^/]+)/ID=[^/]+/NODE\-ID=[^/]+$@) {
723		$grantee = $1;
724	    }
725	    else {
726		die "Expected or mal-formed 'Grantee' line: $line";
727	    }
728	    $next = 1;
729	}
730	elsif ($next == 1) {
731	    if ($line =~ m@^Designate\ Right:\ (.*)$@) {
732		my $oracleRights = $1;
733		$rights = &convertOracleRights($oracleRights);
734	    }
735	    else {
736		die "Expected or mal-formed 'Designate Right' line: $line";
737	    }
738	    &grantUserRights($grantee, $rights, $user);
739	    $next = 0;
740	}
741    }
742
743    close ($rightsfile);
744}
745
746#line:Designate Right: CONFIDENTIALEVENT=NONE/CONFIDENTIALTASK=NONE/NORMALEVENT=MODIFY/NORMALTASK=MODIFY/PERSONALEVENT=VIEWTIME/PERSONALTASK=NONE/PUBLICEVENT=MODIFY/PUBLICTASK=MODIF
747sub convertOracleRights()
748{
749    my $oracleRights = $_[0];
750    my %keyMapping = ( 'CONFIDENTIAL' => 'Confidential',
751		       'NORMAL' => 'Public',
752		       'PUBLIC' => 'Public',
753		       'PERSONAL' => 'Private' );
754    my %valueMapping = ( 'VIEW' => 'Viewer', # à confirmer
755			 'VIEWTIME' => 'DAndTViewer',
756			 'MODIFY' => 'Modifier',
757			 'REPLY' => 'Responder' );
758
759    my %rights = ();
760
761    my @parsedRights = split('/', $oracleRights);
762    foreach my $parsedRight (@parsedRights) {
763	my ($key, $value) = split('=', $parsedRight);
764	if ($key =~ /(.*)EVENT$/ && $value ne 'NONE') {
765	    $key = $1;
766	    die "No mapping found for key '$key'"
767	      unless defined $keyMapping{$key};
768	    die "No mapping found for value '$value'"
769	      unless defined $valueMapping{$value};
770	    $rights{$keyMapping{$key}.$valueMapping{$value}} = 1;
771	}
772    }
773
774    return [keys %rights];
775}
776
777sub grantUserRights()
778{
779    my ($grantee, $rights, $user) = @_;
780
781    die "No grantee specified"
782      unless defined $grantee;
783    die "No rights specified"
784      unless defined $rights;
785    die "No user specified"
786      unless defined $user;
787
788    my $xmlRights = "";
789
790    foreach my $right (@$rights) {
791	$xmlRights .= "<$right/>";
792    }
793    my $content = ( '<?xml version="1.0" encoding="UTF-8"?>' . "\n"
794		    . '<acl-query xmlns="urn:inverse:params:xml:ns:inverse-dav"><set-roles user='
795		    . '"' . $user . '">' . $xmlRights . '</set-roles></acl-query>' );
796
797    my $request = HTTP::Request->new();
798    $request->method('POST');
799    $request->uri(&calendarUrl($user));
800    $request->header('Authorization' => "Basic $pwdhash");
801    $request->header('Content-Type' => 'application/xml');
802    $request->header('Content-Length' => length($content));
803    $request->content($content);
804
805    my $result = &httpRequest($request, $username);
806
807    my $response = $ua->request($request);
808}
809
810##
811## MAIN
812##
813
814if ($#ARGV < 3) {
815    &usage();
816    exit(-1);
817}
818
819$url = $ARGV[0];
820$username = $ARGV[1];
821my $type = $ARGV[2];
822$file = $ARGV[3];
823
824if ($type ne 'events' && $type ne 'tasks' && $type ne 'rights') {
825    usage("The argument 'type' does not have a proper value: '$type'");
826    exit(-1);
827}
828
829# Prepare LDAP connection
830$ldap = new Net::LDAP(LDAP_HOST) or die "Can't connect to LDAP server: $@.\n";
831my $msg = $ldap->bind(LDAP_BIND_DN, password => LDAP_BIND_PW);
832if ($msg->is_error()) {
833    die "Can't bind to LDAP server: ".$msg->error()."\n";
834}
835
836# Verify file name format; extract username
837#if ($file =~ m/^(?!.+?\W)?events\.(\d{8}|invite\d+)$/) {
838#if ($file =~ m/^(?:.+\/)?(events|tasks|rights)\.(\d{8}|invite\d+|[a-z]+)(\.test\d?)?$/) {
839#    $username = $2;
840$email = &getEmailByUsername($ldap, $username);
841print "$username = $email\n";
842
843if (FORCE_USERNAME) {
844    $username = FORCE_USERNAME;
845    print "Force username to $username\n";
846}
847
848# Open iCalendar file
849open (CAL, $file) or die "Can't open file $file: $!\n";
850
851# Prepare HTTP query
852if ($url =~ m#^(https?://)(?:([^:]+):([^@]+)@)?([^/]+)#) {
853    ($authusername, $password, $host) = ($2, $3, $4);
854    $url = $1.$4;
855    if ($host =~ m/:(\d+)/) {
856	$port = $1;
857    }
858    elsif ($url =~ m/^https/) {
859	$port = '443';
860	$host .= ":$port";
861    }
862    else {
863	$port = '80';
864	$host .= ":$port";
865    }
866#    print "host = $host, auth = $authusername\n";
867}
868else {
869    &usage("The URL doesn't have the proper format.");
870    exit(-3);
871}
872
873$pwdhash = encode_base64($authusername . ':' . $password);
874
875$ua = LWP::UserAgent->new();
876$ua->agent('Mozilla/5.0');
877$ua->timeout(1800);
878
879# Verify is user personal calendar exists (or can be automatically created)
880die "Can't access personal calendar of username $username\n"  unless (&userCalendarExists($username));
881
882my $parsers = { 'events' => \&parseEventsFile,
883		'tasks' => \&parseTasksFile,
884		'rights' => \&parseRightsFile };
885$parsers->{$type}($file);
886
887exit;
888