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