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