| 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 .= " " 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;
|
Parent Directory
| 
Revision Log