It's a utf-8 world

[mirror/userdir-ldap-cgi.git] / Util.pm

diff --git a/Util.pm b/Util.pm
index 4cbec32..98668c3 100644 (file)
--- a/Util.pm
+++ b/Util.pm
@@ -2,13 +2,20 @@
 package Util;
 
 use strict;
-use Crypt::Blowfish;
+use Date::Manip qw(ParseDate);
 
 my $blocksize = 8; # A blowfish block is 8 bytes
 my $configfile = "/etc/userdir-ldap/userdir-ldap.conf";
+#my $configfile = "/home/randolph/html/debian/perl/userdir-ldap.conf";
 
 my %config = &ReadConfigFile;
 
+my $hascryptix = 1;
+eval 'use Crypt::Blowfish';
+if ($@) {
+  $hascryptix = undef;
+}
+
 sub CreateKey {
   my $keysize = shift;
   my $input;
@@ -44,10 +51,12 @@ sub Encrypt {
   my $input = shift;
   my ($pos, $output);
 
-  $input .= " " x ($blocksize - (length($input) % $blocksize)) if (length($input % $blocksize));
+  # prepend a length byte */
+  $input = chr(length($input)).$input;
+  $input .= "\001" x ($blocksize - (length($input) % $blocksize)) if (length($input % $blocksize));
 
-  for ($pos = 0; $pos < length($input); $pos += $blocksize) {
-    $output .= unpack("H16", $cipher->encrypt(substr($input, $pos, $blocksize)));
+  for ($pos = 0; $pos < length($input); $pos += $blocksize) {    
+    $output .= unpack("H16", $cipher->encrypt(substr($input, $pos, $blocksize))) if ($hascryptix);
   }
   return $output;
 }
@@ -57,16 +66,18 @@ sub Decrypt {
   # trailing spaces are unimportant.
   my $cipher = shift;
   my $input = shift;
-  my ($pos, $portion, $output);
+  my ($pos, $portion, $output, $len);
   
   ((length($input) % $blocksize) == 0) || &HTMLError("Password corrupted"); # should always be true...
 
   for ($pos = 0; $pos < length($input); $pos += $blocksize*2) {
     $portion = pack("H16", substr($input, $pos, $blocksize*2));
-    $output .= $cipher->decrypt($portion);
+    $output .= $cipher->decrypt($portion) if ($hascryptix);
   }
-    
-  $output =~ s/ +$//;
+  
+  # check length byte, discard junk
+  $len = substr($output, 0, 1);
+  $output = substr($output, 1, ord($len));
   return $output;
 }
 
@@ -108,33 +119,33 @@ sub ReadPasswordFromFile {
   # check to make sure the time is positive, and that the auth token
   # has not expired
   my $tdiff = (time - $time);
-  &HTMLError("Your authentication token has expired. Please <a href=\"$config{webloginhtml}\">relogin</a>") if (($tdiff < 0) || ($tdiff > $config{authexpires}));
+  &HTMLError("Your authentication token has expired. Please <a href=\"https://$ENV{SERVER_NAME}/$config{webloginhtml}\">relogin</a>") if (($tdiff < 0) || ($tdiff > $config{authexpires}));
   
   return Decrypt($cipher, $passwd);
 }
 
 sub CheckAuthToken {
-  my ($id, $hrkey) = split(/:/, shift, 2);
+  my ($id, $hrkey) = split(/,/, shift, 2);
   return undef if (!$id || !$hrkey);
   my $key = pack("H".(length($hrkey)), $hrkey);
   my $cipher = new Crypt::Blowfish $key;
   my $r = ReadPasswordFromFile($id, $cipher);
   if ($r) {
-    UpdateAuthToken("$id:$hrkey", $r);
+    UpdateAuthToken("$id,$hrkey", $r);
   } else {    
-    ClearAuthToken("$id:$hrkey")
+    ClearAuthToken("$id,$hrkey")
   }
   return $r;
 }
 
 sub ClearAuthToken {
-  my ($id, $hrkey) = split(/:/, shift, 2);
+  my ($id, $hrkey) = split(/,/, shift, 2);
   $id =~ y/\//_/; # switch / to _
   unlink "$config{authtokenpath}/$id" || &HTMLError("Error removing authtoken: $!");
 }
 
 sub UpdateAuthToken {
-  my ($id, $hrkey) = split(/:/, shift, 2);
+  my ($id, $hrkey) = split(/,/, shift, 2);
   my $password = shift;
   my $key = pack("H".(length($hrkey)), $hrkey);
   $id =~ y/\//_/; # switch / to _
@@ -169,7 +180,8 @@ sub FormatFingerPrint {
 
 sub FetchKey {
   my $fingerprint = shift;
-  my ($out, $keyringparam);
+  my $signatures = shift;
+  my ($out, $keyringparam) = undef;
   
   foreach (split(/:/, $config{keyrings})) {
     $keyringparam .= "--keyring $_ ";
@@ -178,11 +190,14 @@ sub FetchKey {
   $fingerprint =~ s/\s//g;
   $fingerprint = "0x".$fingerprint;
 
+  local $ENV{PATH} = '';
   $/ = undef; # just suck it up ....
-  open(FP, "$config{gpg} $keyringparam --list-sigs --fingerprint $fingerprint|");
-  $out = <FP>;
-  close FP;
-  open(FP, "$config{gpg} $keyringparam --export -a $fingerprint|");
+  if ($signatures) {
+      open(FP, "$config{gpg} --no-options --no-default-keyring $keyringparam --list-sigs --fingerprint $fingerprint|");
+      $out = <FP>;
+      close FP;
+  }
+  open(FP, "$config{gpg} --no-options --no-default-keyring $keyringparam --export -a $fingerprint|");
   $out .= <FP>;
   close FP;
   $/ = "\n";
@@ -197,6 +212,28 @@ sub FormatTimestamp {
   return sprintf("%04d/%02d/%02d %02d:%02d:%02d UTC", $1,$2,$3,$4,$5,$6);
 }
 
+sub FormatLastSeen {
+# Format:
+# [Tue, 11 Jan 2000 02:37:18] "Joey Hess <joeyh@debian.org>" "<debian-boot@lists.debian.org> archive/latest/7130" "<20000110181924.H19910@kitenet.net>"
+# [Mon, 10 Jan 2000 21:48:19] "9E1E 1052 F8BB A351  0606 5527 50BB 2974 2D59 A7D2" "<debian-devel-changes@lists.debian.org> archive/latest/58632" "<20000110200506.13257.qmail@master.debian.org>"
+  my $lastseenpgp = shift;
+  my $lastseenfrom = shift;
+  my ($d1, $d2, $lastseen);
+
+  return "<b>No activity detected</b>" if (!$lastseenpgp && !$lastseenfrom);
+  $lastseen = $lastseenfrom if (!$lastseenpgp);
+
+  if ($lastseenfrom && $lastseenpgp) {
+    ($d1) = ($lastseenpgp =~ /^\[(.+?)\]/); $d1 = ParseDate($d1);  
+    ($d2) = ($lastseenfrom =~ /^\[(.+?)\]/); $d2 = ParseDate($d2);
+    $lastseen = (($d1 gt $d2) ? $lastseenpgp : $lastseenfrom);
+  }
+
+  my ($date,$user,$list,$msgid) = ($lastseen =~ /^\[(.+?)\]\s+"(.+?)"\s+"(?:<(.+?)>.*?|\-)"\s+"<(.+?)>"/);
+  $list = "on $list" if ($list);
+  return "$date $list<br>&nbsp;Message ID: $msgid";
+}
+
 sub LookupCountry {
   my $in = shift;
   my ($abbrev, $country);
@@ -219,7 +256,7 @@ sub LookupCountry {
 my $htmlhdrsent = 0;
 
 sub HTMLSendHeader {
-  print "Content-type: text/html\n\n" if (!$htmlhdrsent);
+  print "Content-type: text/html; charset=utf-8\n\n" if (!$htmlhdrsent);
   $htmlhdrsent = 1;
 }
 
@@ -245,6 +282,38 @@ sub CheckLatLong {
   }
 }
 
+sub FixParams {
+  my $query = shift;
+  my $key;
+  my @names = $query->param;
+
+  foreach $key (@names) { # web security is a joke ... <sigh>
+    $_ = $query->param($key);
+    s/&/&amp;/g; 
+    s/[<\x8B]/&lt;/g;
+    s/[>\x9B]/&gt;/g;
+
+    $query->param($key, $_);
+  }
+}   
+
+  
+sub LDAPUpdate {
+  my $ldap = shift;
+  my $dn = shift;
+  my $attr = shift;
+  my $val = shift;
+  my $mesg;
+  
+  if (!$val) {
+    $mesg = $ldap->modify($dn, delete => { $attr => [] });
+  } else {
+    $val = [ $val ] if (!ref($val));
+    $mesg = $ldap->modify($dn, replace => { $attr => $val });
+    $mesg->code && &Util::HTMLError("error updating $attr: ".$mesg->error);
+  }
+}
+
 ###################
 # Config file stuff
 sub ReadConfigFile {
@@ -256,11 +325,12 @@ sub ReadConfigFile {
     if ((!/^\s*#/) && ($_ ne "")) {
       # Chop off any trailing comments
       s/#.*//;
-      ($attr, $setting) = split(/=/, $_, 2);
-      $setting =~ s/"//g;
+      /([^=]+)=(.*)/;
+      ($attr, $setting) = ($1, $2);
+      $setting =~ s/"//g; #"
       $setting =~ s/;$//;
-      $attr =~ s/^ +//; $attr =~ s/ +$//;
-      $setting =~ s/^ +//; $setting =~ s/ +$//;      
+      $attr =~ s/^\s+//; $attr =~ s/\s+$//;
+      $setting =~ s/^\s+//; $setting =~ s/\s+$//;      
       $config{$attr} = $setting;
     }
   }