#!/usr/bin/perl
# Read-only access to Sun ONE Calendars using WCAP to export
# iCal format data to Apple iCal/Mozilla Calendar/etc.
#
# put this script in the cgi-bin directory of a web server and change the
# $CALSERVER variable to the address of the Sun ONE/iPlanet calendar server
# to access.
#
# CGI parameters:
#   calendar=CalID	the calendar ID to access (usually a username)
#   start=MM-DD-YYY	the starting date of events to retrieve (if not
#			present, assumes today)
#   end=MM-DD-YYY	the ending date of events to retrieve (if not
#			present, assumes about 2-3 months in advance)
#   user=username	user to log in as to access private calendars
#   pass=password	password to use with username to access private
#			calendars (if only one of user and pass are present,
#			neither is used and access is anonymous)

use strict;
use CGI;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Response;
use HTTP::Date;

my $DEBUG = 0;
my $CALSERVER = "calendar.example.org";

MAIN:
{
	my $query;
	$query = new CGI;

	if ($query->param('calendar')) {
		GetiCal ($query);
	}
}

sub GetiCal ( $ ) {
	my ($query) = @_;
	my $calendar = $query->param('calendar');
	my ($smonth, $emonth, $sday, $eday, $syear, $eyear);
	my ($id, $idstr, $start, $end, $url, $filename);

	if ($query->param('user') && $query->param('pass')) {
		$id = GetLogin ($query->param('user'), $query->param('pass'));
		if ($id && $id ne "") {
			$idstr = "id=$id&";
		}
	}

	
	if ($query->param('start')) {
		($smonth, $sday, $syear) = (split '-', $query->param('start'));
	} else {
		my (@t) = (localtime(time()));
		$syear = $t[5] + 1900;
		$smonth = $t[4]+1;
		$sday = $t[3];
	}
	if ($query->param('end')) {
		($emonth, $eday, $eyear) = (split '-', $query->param('end'));
	} else {
		if ($smonth > 10) {
			$eyear = $syear + 1;
		} else {
			$eyear = $syear;
		}
		$emonth = (($smonth + 2) % 12) + 1;
		$eday = 25;
	}

	$start = sprintf "%04d%02d%02dT000000Z", $syear, $smonth, $sday;
	$end = sprintf "%04d%02d%02dT000000Z", $eyear, $emonth, $eday;

	$url = "http://$CALSERVER/fetchcomponents_by_range.wcap?$idstr"."calid=$calendar&dtstart=$start&dtend=$end&fmt-out=text/calendar";

	if ($DEBUG) {
		open (L, ">>/tmp/ical.log");
		print L "Calendar: $calendar\nStart: $smonth-$sday-$syear\nEnd: $emonth-$eday-$eyear\nURL: $url\n";
		close (L);
	}

	my $request = HTTP::Request->new (GET => $url);
	my $browser = LWP::UserAgent->new;
	$browser->agent("ical/0.1");
	my $response = $browser->request($request);

	$filename = "$calendar.ics";
	$filename =~ s/:/-/g;
	print $query->header(-type=>'text/calendar',
				"Content-Disposition"=>"attachment; filename=$filename");
	print $response->content, "\n";
}

sub GetLogin ($$) {
	my ($user, $pass) = @_;
	my ($url, $id, $content);

	$url = "http://$CALSERVER/login.wcap?user=$user&password=$pass&refresh=1";
	my $request = HTTP::Request->new (GET => $url);
	my $browser = LWP::UserAgent->new;
	$browser->agent("ical/0.1");
	my $response = $browser->simple_request($request);

	$content = $response->content;
	$content =~ /var id='(\w+)'/;
	$id = $1;
	if ($DEBUG) {
		open (L, ">>/tmp/ical.log");
		print L "Login: URL: $url\n";
		print L "$content\n\n$id\n";
		close (L);
	}
	return ($id);
}