#!/usr/bin/perl -w use strict; #use diagnostics; ############################ my $dateFile = '/home/palm/datebook/datebook.dat'; my $passwd = undef; #my $passwd = ""; # for no password my $debug = ""; # parse,task, my $showPrivate = 1; ############################## # # Copyright (c) 2001 by Frederick Dean # # This program is free software; you can redistribute it and/or # modify it under the terms of the Artistic License, a copy of which # can be found with the Perl distribution. # # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # Artistic License for more details. # =head1 webpda.cgi This script will let you see into a palmdesk's address book from a web page. (both *.aba and address.dat files) You can enable Apache for just one CGI file with Options +ExecCGI AddHandler cgi-script .cgi The home page for this script is ... http://fdd.com/software/palm/ Special thanks to Scott Leighton . http:///www.geocities.com/Heartland/Acres/3216/address_dat.htm =cut print("content-type: text/plain\n\n") if $debug; use Date::Format; use Date::Parse; # Decode the escaping of a URL sub urlUnquote { my ($tounquote) = (@_); $tounquote =~ tr/+/ /; # pluses become spaces $tounquote =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; return $tounquote; } # Quotify a string, suitable for putting into a URL. sub urlQuote { my($toencode) = (@_); $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg; return $toencode; } sub Fatal { my ($error) = (@_); print( "content-type: text/html\n\n". "
Fatal Error
\n". "" . htmlQuote($error) . "\n" . "\n"); exit(1); } my %form; # This is the has of form data submitted # The keys are the "name=" of the HTML form # useful for debugging. Prints %form sub PrintFormHash { print("
\n\n"); for my $key (keys(%form)) { print("$key => $form{$key}
\n"); } print("
\n"); } # Here we parse the data from apache into a hash sub MakeFormHash { my $queryString = ""; if(defined($ENV{"REQUEST_METHOD"}) and $ENV{"REQUEST_METHOD"} eq "POST") { read(STDIN,$queryString,$ENV{"CONTENT_LENGTH"}); } elsif(defined($ENV{"QUERY_STRING"})) { $queryString = $ENV{"QUERY_STRING"}; } # $queryString looks like pw=passwd&name=rick+dean my @pairs = split('&',$queryString); for my $pair (@pairs) { if($pair =~ /([^=]*)=(.*)/) { $form{$1} = urlUnquote($2); }; } } # useful for debugging sub PrintEnv { print("
\n"); for my $key (keys(%ENV)) { print("$key => $ENV{$key}
\n"); } } # This makes a new URL being smart about the state we want to keep. # The args are a list of "value=param" or "value1=param1&value2=param2" sub Link { my @params = @_; my %answer; my @keepers = qw{ pw sort zone }; for my $keeper (@keepers) { # for every keeper if(defined($form{$keeper})) { $answer{$keeper} = $form{$keeper}; }; }; for my $parampair (@params) { # for every new parameter for my $param (split("&",$parampair)) { $param =~ m/(.*?)=(.*)/; $answer{$1} = $2; }; }; my $answer = ""; for my $key (keys(%answer)) { # for every answer param $answer .= "$key=" . urlQuote($answer{$key}) . '&'; # append } chop($answer); # kill trailing '&' my $progname = $ENV{'REQUEST_URI'} || $0; $progname =~ s|\?.*||; # trim the question mark and beyond $progname =~ s|.*/||; # trim everything up to last slash return(""); } sub CheckForPasswd { if(!defined($passwd)) { Fatal("Someone needs to set up the password by editing the " . "top of the CGI script."); }; if($passwd eq "") { # no password (public database?) return; }; $passwd = crypt($passwd,"xA"); if(defined($form{'passwd'})) { $form{'pw'} = crypt($form{'passwd'},"xA"); }; if(!defined($form{'pw'}) or $form{'pw'} ne $passwd) { PrintHeader("WebPDA Login"); if(defined($form{'pw'})) { sleep(2); # make exhaustive searches more annoying print("

Password Incorrect

\n"); }; my $progname = $ENV{REQUEST_URI} || $0; print("
\n". " Please enter your password:
\n". " \n". " \n". "
\n". "\n"); exit(); }; } # returns a string converted to html # double spaces and newlines are not processed sub htmlQuote { my ($html) = (@_); $html =~ s/\&/\&/g; $html =~ s//\>/g; $html =~ s/\n/\n
/g; return $html; } # Create a new has of everythin html quoted sub htmlQuoteHash { my ($orig) = (@_); my %quoted; for my $key (keys(%$orig)) { $quoted{$key} = htmlQuote($$orig{$key}); }; return \%quoted; } # Palm stores some stuff as CStrings # If the string is less than 255 chars long, it is one byte # of length then the string, otherwise it is a 0xff byte, # two bytes of length (LSB first) and then the data. # # Palm apparently first wrote the PalmDesk using MFC, # and stored the data as MFC packed streamed data, which puts # four bytes of zeros before the string. sub ReadCString { my ($fh,$comment,$noGarbageFlag) = (@_); if(!$noGarbageFlag) { read($fh,my $garbage,4) or return undef; }; my $tell = tell($fh); read($fh,my $lengthByte,1) or return undef; my $length = unpack("C",$lengthByte); if($length == 0xff) { # we read the integer as two byte explicitly to avoid endian problems read($fh,$lengthByte,1) or return undef; $length = unpack("C",$lengthByte); read($fh,$lengthByte,1) or return undef; $length = ($length << 8) + unpack("C",$lengthByte); }; my $string; if($length == 0) { $string = ""; } else { read($fh,$string,$length) or return undef; }; printf("tell=$tell %25s length=$length string=$string\n",$comment) if $debug =~ /parse/; return $string; } # Read a 32-bit integer. # We read the integer as explicit bytes to avoid endian problems. sub ReadLongInt { my ($fh,$comment) = (@_); my $tell = tell($fh); read($fh,my $byte1,1) or return undef; read($fh,my $byte2,1) or return undef; read($fh,my $byte3,1) or return undef; read($fh,my $byte4,1) or return undef; my $int = (unpack("C",$byte4) << 24) + (unpack("C",$byte3) << 16) + (unpack("C",$byte2) << 8) + unpack("C",$byte1); printf("tell=$tell %25s int=$int (0x%08x)\n",$comment,$int) if $debug =~ /parse/; return $int; } sub ReadShortInt { my ($fh,$comment) = (@_); my $tell = tell($fh); read($fh,my $byte,1) or return undef; my $int = unpack("C",$byte); read($fh,$byte,1) or return undef; $int = $int + (unpack("C",$byte) << 8); printf("tell=$tell %25s int=$int (0x%04x) \n",$comment,$int) if $debug =~ /parse/; return $int; } sub ReadByte { my ($fh,$comment) = (@_); my $tell = tell($fh); read($fh,my $byte,1) or return undef; my $int = unpack("C",$byte); printf("tell=$tell %25s byte=$int (0x%04x) \n",$comment,$int) if $debug =~ /parse/; return $int; } # We store the addresses as a list of hash references # Each record (person) has his own hash. my @records; # if we are only using one record. my(%categories,%revCategories); sub LoadDateFile { my $fh = $_[0]; ReadLongInt($fh,"version tag"); # 0x00014241 my $filename = ReadCString($fh,"true filename",1); # filename my $customShowHeader = ReadCString($fh,"custom show header",1); my $nextId = ReadLongInt($fh,"next free category id"); # should be 0x00000083 my $categoryCount = ReadLongInt($fh,"category count"); while($categoryCount-- > 0) { my $index = ReadLongInt($fh,"category index"); ReadLongInt($fh,"category id"); ReadLongInt($fh,"dirty flag"); my $name = ReadCString($fh,"long category name",1); ReadCString($fh,"short category name",1); $categories{$index} = $name; $revCategories{$name} = $index; } $categories{0} = "Unfiled"; # schema ReadLongInt($fh,"resource id"); my $fieldsPerRow = ReadLongInt($fh,"fields per row (30)"); ReadLongInt($fh,"record id position"); ReadLongInt($fh,"record status position"); ReadLongInt($fh,"placement position"); my $numFields = ReadShortInt($fh,"field count"); my @fields = (); while($numFields-- > 0) { push(@fields,ReadShortInt($fh,"field entry")); }; print($#fields+1," fields are ",join(",",@fields),"\n") if $debug =~ /parse/; my $numEntries = ReadLongInt($fh,"num entries"); print($numEntries/$fieldsPerRow," records in file\n") if $debug =~ /parse/; $numEntries = $numEntries / $fieldsPerRow; while($numEntries-- > 0) { my %record; # type: none=0 long=1 float=2 date=3 alpha=4 cstr=5 bool=6 bitflag=7 repeatevent=8 ReadLongInt($fh,"field type"); last if eof($fh); $record{'id'} = ReadLongInt($fh,"record id"); #print("record id = $record{'id'}\n"); ReadLongInt($fh,"field type"); # status: 0x08=pending 0x01=add 0x02=update 0x04=del 0x80=archive $record{'status'} = ReadLongInt($fh,"status"); ReadLongInt($fh,"field type"); $record{'position'} = ReadLongInt($fh,"position"); ReadLongInt($fh,"field type"); $record{'start'} = ReadLongInt($fh,"start time"); ReadLongInt($fh,"field type"); $record{'end'} = ReadLongInt($fh,"end time"); ReadLongInt($fh,"field type"); $record{'description'} = ReadCString($fh,"description"); ReadLongInt($fh,"field type"); #print("
" . time2str("%C",$record{'start'}) . " to " . time2str("%C",$record{'end'}) . " is $record{'description'}\n"); $record{'duration'} = ReadLongInt($fh,"duration"); ReadLongInt($fh,"field type"); $record{'note'} = ReadCString($fh,"note"); ReadLongInt($fh,"field type"); $record{'untimed'} = ReadLongInt($fh,"untimed"); ReadLongInt($fh,"field type"); $record{'private'} = ReadLongInt($fh,"private"); ReadLongInt($fh,"field type"); $record{'category'} = ReadLongInt($fh,"category"); ReadLongInt($fh,"field type"); $record{'alarmset'} = ReadLongInt($fh,"alarm set"); ReadLongInt($fh,"field type"); $record{'alarmAdvUnits'} = ReadLongInt($fh,"alarm advance units"); ReadLongInt($fh,"field type"); $record{'alarmAdvType'} = ReadLongInt($fh,"alarm advance type (0=minutes,1=hours,2-Days"); ReadLongInt($fh,"field type"); my $numDateExceptions = ReadShortInt($fh,"date exceptions"); while($numDateExceptions--) { ReadLongInt($fh,"date exception entry"); }; $record{'repeatEvent'} = ReadShortInt($fh,"repeat event flag"); if($record{'repeatEvent'} == 0xffff) { # if class entry ReadShortInt($fh,"constant") == 1 or die; my $classNameLength = ReadShortInt($fh,"length of class name"); if($classNameLength) { read($fh,my $string,$classNameLength); }; }; if($record{'repeatEvent'} != 0) { # brand data of repeat $record{'repeatBrand'} = ReadLongInt($fh,"repeat brand"); $record{'interval'} = ReadLongInt($fh,"interval"); $record{'endDate'} = ReadLongInt($fh,"end date"); $record{'firstDayOfWeek'} = ReadLongInt($fh,"first day of week"); if($record{'repeatBrand'} >= 1 && $record{'repeatBrand'} <= 3) { $record{'dayIndex'} = ReadLongInt($fh,"interval (brands 1-3)"); }; if($record{'repeatBrand'} == 2) { $record{'daysMask'} = ReadByte($fh,"daysMask (only brand 2)"); }; if($record{'repeatBrand'} == 3) { $record{'weekIndex'} = ReadByte($fh,"weekIndex (only brand 3)"); }; if($record{'repeatBrand'} >= 4 && $record{'repeatBrand'} <= 5) { $record{'dayNumber'} = ReadLongInt($fh,"interval (brands 4-5)"); }; if($record{'repeatBrand'} == 5) { $record{'monthIndex'} = ReadByte($fh,"month Index"); }; }; last if eof($fh); # if incomplete record next if $record{'private'} && !$showPrivate; push(@records,\%record); # save hash reference in list }; } sub LoadDatebook { -e $dateFile or Fatal("file $dateFile doesn't exist"); -r $dateFile or Fatal("I don't have read permission for file $dateFile"); print("opening $dateFile\n") if $debug =~ /task/; if(!open(DAT,"<$dateFile")) { PrintHeader(); print("Could not open $dateFile\n"); exit(); } LoadDateFile(\*DAT); close(DAT); } # Here we store the events as a hash of days for lookup performance. # Each hash element is a (reference to a) list of references to records. # Those records of course are themselves hashes. my %dayRecords; my $tzOffset = str2time("1 jan 1970 00:00",$form{'zone'}); sub MakeDayIndex { for my $recref (@records) { # for every record my $day = ($$recref{'start'} - $tzOffset) % (24*3600); if(exists $dayRecords{$day}) { push(@{$dayRecords{$day}},$recref); } else { $dayRecords{$day} = [ $recref ]; }; } } sub justPrintDay { my($start,$dayOfMonth,$current,$monthname) = @_; my $color = "#ffffff"; $color = "#ffdd0d" if (time2str("%e %B %Y",time()) eq "$dayOfMonth $monthname"); if($current) { print("" .Link("day=$dayOfMonth $monthname") . "$dayOfMonth
") } else { print(" \n"); }; } sub printDayEventsSquare { my($start,$dayOfMonth,$current,$monthname) = @_; my ($headcolor,$bodycolor) = ("#aaaaaa","#cccccc"); ($headcolor,$bodycolor) = ("#dddddd","#ffffff") if($current); ($headcolor,$bodycolor) = ("#ddbb0d","#ffdd0d") if(time2str("%e %B %Y",time()) eq "$dayOfMonth $monthname"); print(" \n"); print("
" . Link("day=$dayOfMonth $monthname") . "\n" . "$dayOfMonth
 \n"); my $day = ($start - $tzOffset) % (3600*24); for my $recref (@records) { next if($$recref{'end'} < $start || $$recref{'start'} > $start + 24*3600); # for my $recref (@{$dayRecords{$day}}) { print("",time2str("%l:%M %p",$$recref{'start'}),""); print(" $$recref{'description'}
\n"); } print("
\n"); print(" \n"); } sub MonthInfo { my ($whenstr) = (@_); my $when; if(!defined($whenstr) || $whenstr eq "") { $when = time(); } elsif($whenstr =~ /^-?\d+$/) { $when = time() + 30.5 * 24 * 3600 * $whenstr; } else { $when = str2time("15 $whenstr 00:00") || str2time($whenstr); }; if(!defined($when)) { Fatal("I don't know \"". htmlQuote($whenstr) . '"'); } my $monthname = time2str("%B %Y",$when); my $start = str2time("1 $monthname 00:00"); my $end = str2time("1 " . time2str("%B %Y",$start + 45*24*3600). " 00:00"); my $daysInMonth = time2str("%e",$end - 10); return ($monthname,$start,$end,$daysInMonth); } # This will create a table for the month and call dayPrintFunc # for each day. sub PrintMonthView { my ($whenstr,$dayPrintFunc) = (@_); my ($monthname,$start,$end,$daysInMonth) = MonthInfo($whenstr); my ($nextmonthname,$nextstart,$nextend,$nextdaysInMonth) = MonthInfo(time2str("%B %Y",$end + 1000)); my ($prevmonthname,$prevstart,$prevend,$prevdaysInMonth) = MonthInfo(time2str("%B %Y",$start - 1000)); print("\n"); print(" \n"); print(" \n"); my $dayOfWeekOffset = time2str("%w",$start); for my $cellNum (1..49) { print(" \n") if (($cellNum-1) % 7 == 0); my $day = $cellNum - $dayOfWeekOffset; my $daystart = $start + ($day-1)*24*3600; if($day < 1) { # if actually previous month &$dayPrintFunc($daystart,$day + $prevdaysInMonth,0,$prevmonthname); } elsif($day > $daysInMonth) { # if next month &$dayPrintFunc($daystart,$day - $daysInMonth,0,$nextmonthname); } else { # else is truely this month &$dayPrintFunc($daystart,$day,1,$monthname); }; print(" \n") if (($cellNum-1) % 7 == 6); }; print("
" . Link("month=$prevmonthname") . "<<\n" ); print(Link("month=$monthname") . "\n" ); print("$monthname\n"); print("\n"); print(Link("month=$nextmonthname") . ">>
\n"); } sub PrintDayView { my ($whenstr) = (@_); print("PrintDayView()\n") if $debug =~ /task/; $whenstr = scalar(localtime()) if(!defined($whenstr) || $whenstr eq "" || $whenstr eq "now"); my $when = str2time($whenstr); if(!defined($when)) { Fatal("I don't know the date \"". htmlQuote($whenstr) . '"'); } my $dayname = time2str("%A %B %e, %Y 00:00",$when); my $start = str2time($dayname); my $end = $start + 24*3600; #print("start=$start end=$end
\n"); #print("start=" . time2str("%C",$start) . " end=". time2str("%C",$end) . "
\n"); print("\n"); print(" \n"); my $foundOne; for my $recref (@records) { # for every record next if($$recref{'end'} < $start); next if($$recref{'start'} > $end); PrintDetailedEvent($$recref{'id'}); $foundOne = 1; #print(" \n"); }; print("\n") if ! $foundOne; print("
$dayname
id:blah
Sorry, no events found.
\n"); } sub PrintDetailedEvent { my ($id) = (@_); print("PrintDetailedEvent(id=$id)\n") if $debug =~ /task/; my $recref; for my $maybeRecref (@records) { if($$maybeRecref{'id'} == $id) { $recref = $maybeRecref; last; } }; if(!defined($recref)) { print("id #$id not found\n"); return; }; $recref = htmlQuoteHash($recref); print("\n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); print(" \n"); } =cmeafdsfdsaf sub PrintCategoryLinks { print(Link() . "All
"); for my $id (sort(keys(%categories))) { my $name = $categories{$id}; print(Link("category=$name") . htmlQuote($name)."
"); }; } =cut sub PrintHeader { my ($title) = (@_); if(!defined($title)) { $title = "WebPDA"; }; print("content-type: text/html\n\n". "\n". "$title\n". "\n". " $title
\n"); print("

Warning: This script is work in progress. Recurring events don't show.

"); } sub PrintMainTable { print("
Event
id:$$recref{'id'}
status:$$recref{'status'}
position:$$recref{'position'}
start:". time2str("%C",$$recref{'start'}) . "
end:". time2str("%C",$$recref{'end'}) . "
description:$$recref{'description'}
duration:$$recref{'duration'}
note:$$recref{'note'}
untimed:$$recref{'untimed'}
private:$$recref{'private'}
category:$$recref{'category'}
alarmset:$$recref{'alarmset'}
\n"); } sub PrintFooter { print("\n"); #print("
Addresses
\n"); PrintMonthView(-1,\&justPrintDay); PrintMonthView(0,\&justPrintDay); PrintMonthView(1,\&justPrintDay); =asdfsadf print("
Search
\n"); print("
\n"); print("
\n"); print("
\n"); print("\n"); print("
\n"); =cut print("
\n"); } MakeFormHash(); CheckForPasswd(); # may not return $form{'zone'} ||= time2str("Z",0); # default time zone is local time zone print("password okay\n") if $debug =~ /task/; PrintHeader(); PrintMainTable(); LoadDatebook(); MakeDayIndex(); print("loaded okay\n") if $debug =~ /task/; if($form{'day'}) { PrintDayView($form{'day'}); } elsif($form{'id'}) { PrintDetailedEvent($form{'id'}); } else { PrintMonthView($form{'month'},\&printDayEventsSquare); }; PrintFooter(); #PrintFormHash(); print("done\n") if $debug =~ /task/;