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";
11 my %config = &ReadConfigFile;
16 open (F, "</dev/urandom") || die &HTMLError("No /dev/urandom found!");
17 read(F, $input, $keysize); # key length is 8 bytes
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);
30 my $cryptsaltlen = ($md5 ? 8 : 2);
32 open (F, "</dev/urandom") || die &HTMLError("No /dev/urandom found!");
33 foreach (1..$cryptsaltlen) {
35 $out .= $valid[ord($in) % ($#valid + 1)];
38 return ($md5 ? "\$1\$$out\$" : $out);
42 # blowfish only encrypts things in blocks of 8 bytes, so we
43 # need a custom routine that handles longer strings....
48 $input .= " " x ($blocksize - (length($input) % $blocksize)) if (length($input % $blocksize));
50 for ($pos = 0; $pos < length($input); $pos += $blocksize) {
51 $output .= unpack("H16", $cipher->encrypt(substr($input, $pos, $blocksize)));
57 # like encrypt, needs to deal with big blocks. Note that we assume
58 # trailing spaces are unimportant.
61 my ($pos, $portion, $output);
63 ((length($input) % $blocksize) == 0) || &HTMLError("Password corrupted"); # should always be true...
65 for ($pos = 0; $pos < length($input); $pos += $blocksize*2) {
66 $portion = pack("H16", substr($input, $pos, $blocksize*2));
67 $output .= $cipher->decrypt($portion);
74 sub SavePasswordToFile {
79 my $cryptuser = crypt($userid, &CreateCryptSalt);
80 my $secret = Encrypt($cipher, $password);
81 $cryptuser =~ y/\//_/; # translate slashes to underscores...
83 my $fn = "$config{authtokenpath}/$cryptuser";
84 open (F, ">$fn") || &HTMLError("$fn: $!");
92 sub ReadPasswordFromFile {
98 $userid =~ y/\//_/; # translate slashes to underscores...
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>);
106 # check to make sure we read something
107 return undef if (!$passwd || !$time);
109 # check to make sure the time is positive, and that the auth token
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}));
114 return Decrypt($cipher, $passwd);
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);
124 UpdateAuthToken("$id:$hrkey", $r);
126 ClearAuthToken("$id:$hrkey")
132 my ($id, $hrkey) = split(/:/, shift, 2);
133 $id =~ y/\//_/; # switch / to _
134 unlink "$config{authtokenpath}/$id" || &HTMLError("Error removing authtoken: $!");
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);
145 my $fn = "$config{authtokenpath}/$id";
146 open (F, ">$fn") || &HTMLError("$fn: $!");
150 chmod 0600, "$fn" || &HTMLError("$fn: $!");
154 sub FormatFingerPrint {
158 if (length($in) == 32) {
160 $out .= substr($in, $_*2, 2)." ";
161 $out .= " " if ($_ == 7);
164 foreach (0..int(length($in)/2)) {
165 $out .= substr($in, $_*4, 4)." ";
172 my $fingerprint = shift;
173 my ($out, $keyringparam) = undef;
175 foreach (split(/:/, $config{keyrings})) {
176 $keyringparam .= "--keyring $_ ";
179 $fingerprint =~ s/\s//g;
180 $fingerprint = "0x".$fingerprint;
182 $/ = undef; # just suck it up ....
183 open(FP, "$config{gpg} --no-options --no-default-keyring $keyringparam --list-sigs --fingerprint $fingerprint|");
186 open(FP, "$config{gpg} --no-options --no-default-keyring $keyringparam --export -a $fingerprint|");
194 sub FormatTimestamp {
196 $in =~ /^(....)(..)(..)(..)(..)(..)/;
198 return sprintf("%04d/%02d/%02d %02d:%02d:%02d UTC", $1,$2,$3,$4,$5,$6);
203 my ($abbrev, $country);
204 open (F, $config{countrylist}) || return uc($in);
207 ($abbrev, $country) = split(/\s+/, $_, 2);
208 if ($abbrev eq $in) {
223 print "Content-type: text/html\n\n" if (!$htmlhdrsent);
228 &HTMLSendHeader if (!$htmlhdrsent);
238 my ($lat, $long) = @_;
240 $lat =~ s/[^-+\.\d]//g; $long =~ s/[^-+\.\d]//g;
242 if (($lat =~ /^(\-|\+?)\d+(\.\d+)?/) && ($long =~ /^(\-|\+?)\d+(\.\d+)?/)) {
243 return ($lat, $long);
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: $!");
257 if ((!/^\s*#/) && ($_ ne "")) {
258 # Chop off any trailing comments
260 ($attr, $setting) = split(/=/, $_, 2);
263 $attr =~ s/^ +//; $attr =~ s/ +$//;
264 $setting =~ s/^ +//; $setting =~ s/ +$//;
265 $config{$attr} = $setting;