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