web/Util.pm

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