Util.pm

   1 # -*- perl -*-x
   2 package Util;
   3
   4 use strict;
   5
   6 my $blocksize = 8; # A blowfish block is 8 bytes
   7 my $configfile = "/etc/userdir-ldap/userdir-ldap.conf";
   8 #my $configfile = "/home/randolph/html/debian/perl/userdir-ldap.conf";
   9
  10 my %config = &ReadConfigFile;
  11
  12 my $hascryptix = 1;
  13 eval 'use Crypt::Blowfish';
  14 if ($@) {
  15   $hascryptix = undef;
  16 }
  17
  18 sub CreateKey {
  19   my $keysize = shift;
  20   my $input;
  21   open (F, "</dev/urandom") || die &HTMLError("No /dev/urandom found!");
  22   read(F, $input, $keysize); # key length is 8 bytes
  23   close F;
  24
  25   return $input;
  26 }
  27
  28 sub CreateCryptSalt {
  29   # this can create either a DES type salt or a MD5 salt
  30   my $md5 = shift; # do we want a MD5 salt?
  31   my $validstr = './0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
  32   my @valid = split(//,$validstr);
  33   my ($in, $out);
  34
  35   my $cryptsaltlen = ($md5 ? 8 : 2);
  36
  37   open (F, "</dev/urandom") || die &HTMLError("No /dev/urandom found!");
  38   foreach (1..$cryptsaltlen) {
  39     read(F, $in, 1);
  40     $out .= $valid[ord($in) % ($#valid + 1)];
  41   }
  42   close F;
  43   return ($md5 ? "\$1\$$out\$" : $out);
  44 }
  45
  46 sub Encrypt {
  47   # blowfish only encrypts things in blocks of 8 bytes, so we
  48   # need a custom routine that handles longer strings....
  49   my $cipher = shift;
  50   my $input = shift;
  51   my ($pos, $output);
  52
  53   $input .= " " x ($blocksize - (length($input) % $blocksize)) if (length($input % $blocksize));
  54
  55   for ($pos = 0; $pos < length($input); $pos += $blocksize) {
  56     $output .= unpack("H16", $cipher->encrypt(substr($input, $pos, $blocksize))) if ($hascryptix);
  57   }
  58   return $output;
  59 }
  60
  61 sub Decrypt {
  62   # like encrypt, needs to deal with big blocks. Note that we assume
  63   # trailing spaces are unimportant.
  64   my $cipher = shift;
  65   my $input = shift;
  66   my ($pos, $portion, $output);
  67
  68   ((length($input) % $blocksize) == 0) || &HTMLError("Password corrupted"); # should always be true...
  69
  70   for ($pos = 0; $pos < length($input); $pos += $blocksize*2) {
  71     $portion = pack("H16", substr($input, $pos, $blocksize*2));
  72     $output .= $cipher->decrypt($portion) if ($hascryptix);
  73   }
  74
  75   $output =~ s/ +$//;
  76   return $output;
  77 }
  78
  79 sub SavePasswordToFile {
  80   my $userid = shift;
  81   my $password = shift;
  82   my $cipher = shift;
  83
  84   my $cryptuser = crypt($userid, &CreateCryptSalt);
  85   my $secret = Encrypt($cipher, $password);
  86   $cryptuser =~ y/\//_/; # translate slashes to underscores...
  87
  88   my $fn = "$config{authtokenpath}/$cryptuser";
  89   open (F, ">$fn") || &HTMLError("$fn: $!");
  90   print F "$secret\n";
  91   print F time."\n";
  92   close F;
  93   chmod 0600, $fn;
  94   return $cryptuser;
  95 }
  96
  97 sub ReadPasswordFromFile {
  98   my $userid = shift;
  99   my $cipher = shift;
 100   my $passwd;
 101   my $time;
 102
 103   $userid =~ y/\//_/; # translate slashes to underscores...
 104
 105   # if we couldn't read the password file, assume user is unauthenticated. is this ok?
 106   open (F, "<$config{authtokenpath}/$userid") || return undef;
 107   chomp($passwd = <F>);
 108   chomp($time = <F>);
 109   close F;
 110
 111   # check to make sure we read something
 112   return undef if (!$passwd || !$time);
 113
 114   # check to make sure the time is positive, and that the auth token
 115   # has not expired
 116   my $tdiff = (time - $time);
 117   &HTMLError("Your authentication token has expired. Please <a href=\"$config{webloginhtml}\">relogin</a>") if (($tdiff < 0) || ($tdiff > $config{authexpires}));
 118
 119   return Decrypt($cipher, $passwd);
 120 }
 121
 122 sub CheckAuthToken {
 123   my ($id, $hrkey) = split(/,/, shift, 2);
 124   return undef if (!$id || !$hrkey);
 125   my $key = pack("H".(length($hrkey)), $hrkey);
 126   my $cipher = new Crypt::Blowfish $key;
 127   my $r = ReadPasswordFromFile($id, $cipher);
 128   if ($r) {
 129     UpdateAuthToken("$id,$hrkey", $r);
 130   } else {
 131     ClearAuthToken("$id,$hrkey")
 132   }
 133   return $r;
 134 }
 135
 136 sub ClearAuthToken {
 137   my ($id, $hrkey) = split(/,/, shift, 2);
 138   $id =~ y/\//_/; # switch / to _
 139   unlink "$config{authtokenpath}/$id" || &HTMLError("Error removing authtoken: $!");
 140 }
 141
 142 sub UpdateAuthToken {
 143   my ($id, $hrkey) = split(/,/, shift, 2);
 144   my $password = shift;
 145   my $key = pack("H".(length($hrkey)), $hrkey);
 146   $id =~ y/\//_/; # switch / to _
 147   my $cipher = new Crypt::Blowfish $key;
 148   my $secret = Encrypt($cipher, $password);
 149
 150   my $fn = "$config{authtokenpath}/$id";
 151   open (F, ">$fn") || &HTMLError("$fn: $!");
 152   print F "$secret\n";
 153   print F time."\n";
 154   close F;
 155   chmod 0600, "$fn" || &HTMLError("$fn: $!");
 156   return 1;
 157 }
 158
 159 sub FormatFingerPrint {
 160   my $in = shift;
 161   my $out;
 162
 163   if (length($in) == 32) {
 164     foreach (0..15) {
 165       $out .= substr($in, $_*2, 2)." ";
 166       $out .= "&nbsp;" if ($_ == 7);
 167     }
 168   } else {
 169     foreach (0..int(length($in)/2)) {
 170       $out .= substr($in, $_*4, 4)." ";
 171     }
 172   }
 173   return $out;
 174 }
 175
 176 sub FetchKey {
 177   my $fingerprint = shift;
 178   my ($out, $keyringparam) = undef;
 179
 180   foreach (split(/:/, $config{keyrings})) {
 181     $keyringparam .= "--keyring $_ ";
 182   }
 183
 184   $fingerprint =~ s/\s//g;
 185   $fingerprint = "0x".$fingerprint;
 186
 187   $/ = undef; # just suck it up ....
 188   open(FP, "$config{gpg} --no-options --no-default-keyring $keyringparam --list-sigs --fingerprint $fingerprint|");
 189   $out = <FP>;
 190   close FP;
 191   open(FP, "$config{gpg} --no-options --no-default-keyring $keyringparam --export -a $fingerprint|");
 192   $out .= <FP>;
 193   close FP;
 194   $/ = "\n";
 195
 196   return $out;
 197 }
 198
 199 sub FormatTimestamp {
 200   my $in = shift;
 201   $in =~ /^(....)(..)(..)(..)(..)(..)/;
 202
 203   return sprintf("%04d/%02d/%02d %02d:%02d:%02d UTC", $1,$2,$3,$4,$5,$6);
 204 }
 205
 206 sub LookupCountry {
 207   my $in = shift;
 208   my ($abbrev, $country);
 209   open (F, $config{countrylist}) || return uc($in);
 210   while (<F>) {
 211     chomp;
 212     ($abbrev, $country) = split(/\s+/, $_, 2);
 213     if ($abbrev eq $in) {
 214       close F;
 215       return $country;
 216     }
 217   }
 218   close F;
 219   return uc($in);
 220 }
 221
 222 ####################
 223 # Some HTML Routines
 224
 225 my $htmlhdrsent = 0;
 226
 227 sub HTMLSendHeader {
 228   print "Content-type: text/html\n\n" if (!$htmlhdrsent);
 229   $htmlhdrsent = 1;
 230 }
 231
 232 sub HTMLPrint {
 233   &HTMLSendHeader if (!$htmlhdrsent);
 234   print shift;
 235 }
 236
 237 sub HTMLError {
 238   HTMLPrint(shift);
 239   die "\n";
 240 }
 241
 242 sub CheckLatLong {
 243   my ($lat, $long) = @_;
 244
 245   $lat =~ s/[^-+\.\d]//g; $long =~ s/[^-+\.\d]//g;
 246
 247   if (($lat =~ /^(\-|\+?)\d+(\.\d+)?/) && ($long =~ /^(\-|\+?)\d+(\.\d+)?/)) {
 248     return ($lat, $long);
 249   } else {
 250     return ("", "");
 251   }
 252 }
 253
 254 ###################
 255 # Config file stuff
 256 sub ReadConfigFile {
 257   # reads a config file and results a hashref with the results
 258   my (%config, $attr, $setting);
 259   open (F, "<$configfile") || &HTMLError("Cannot open $configfile: $!");
 260   while (<F>) {
 261     chomp;
 262     if ((!/^\s*#/) && ($_ ne "")) {
 263       # Chop off any trailing comments
 264       s/#.*//;
 265       ($attr, $setting) = split(/=/, $_, 2);
 266       $setting =~ s/"//g; #"
 267       $setting =~ s/;$//;
 268       $attr =~ s/^\s+//; $attr =~ s/\s+$//;
 269       $setting =~ s/^\s+//; $setting =~ s/\s+$//;
 270       $config{$attr} = $setting;
 271     }
 272   }
 273   close F;
 274   return %config;
 275 }
 276
 277 1;