# -*- perl -*-x
+
+# Copyright (c) 1999-2006 Debian Admin Team Members and Developers (taken from debian/copyright in 2008 by weasel)
+# Copyright (c) 2002, 2003, 2004, 2008, 2009, 2011, 2012, 2014, 2015 Peter Palfrader
+
package Util;
use strict;
use Date::Manip qw(ParseDate);
+use Net::LDAP qw(LDAP_SUCCESS LDAP_PROTOCOL_ERROR);
+use English;
+use Crypt::CBC;
+use Digest::HMAC_SHA1 qw(hmac_sha1_hex);
my $blocksize = 8; # A blowfish block is 8 bytes
my $configfile = "/etc/userdir-ldap/userdir-ldap.conf";
my %config = &ReadConfigFile;
-my $hascryptix = 1;
-eval 'use Crypt::Blowfish';
-if ($@) {
- $hascryptix = undef;
-}
-
sub CreateKey {
my $keysize = shift;
my $input;
- open (F, "</dev/urandom") || die &HTMLError("No /dev/urandom found!");
+ open (F, "<", "/dev/urandom") || die &HTMLError("No /dev/urandom found!");
read(F, $input, $keysize); # key length is 8 bytes
close F;
-
+
return $input;
}
sub CreateCryptSalt {
+ # CreateCryptSalt(type = 0, skip_header = 0)
# this can create either a DES type salt or a MD5 salt
+ # 0 for DES, 1 for MD5 salt
+ # if skip_header is 0, does not add $1$ for md5 salts.
my $md5 = shift; # do we want a MD5 salt?
+ my $no_crypttype_header = shift;
my $validstr = './0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
my @valid = split(//,$validstr);
my ($in, $out);
-
+
my $cryptsaltlen = ($md5 ? 8 : 2);
-
+
open (F, "</dev/urandom") || die &HTMLError("No /dev/urandom found!");
foreach (1..$cryptsaltlen) {
read(F, $in, 1);
$out .= $valid[ord($in) % ($#valid + 1)];
}
close F;
- return ($md5 ? "\$1\$$out\$" : $out);
+ if ($md5 == 1 && !$no_crypttype_header) { $out = "\$1\$$out\$"; }
+ return $out
}
-sub Encrypt {
- # blowfish only encrypts things in blocks of 8 bytes, so we
- # need a custom routine that handles longer strings....
- my $cipher = shift;
- my $input = shift;
- my ($pos, $output);
+sub Encrypt {
+ my $hexkey = shift;
+ my $plaintext = shift;
- # prepend a length byte */
- $input = chr(length($input)).$input;
- $input .= "\001" x ($blocksize - (length($input) % $blocksize)) if (length($input % $blocksize));
+ my $cipher = Crypt::CBC->new( -key => $hexkey, -cipher => 'Blowfish');
+ my $ciphertext_hex = $cipher->encrypt_hex($plaintext);
- for ($pos = 0; $pos < length($input); $pos += $blocksize) {
- $output .= unpack("H16", $cipher->encrypt(substr($input, $pos, $blocksize))) if ($hascryptix);
- }
- return $output;
+ return $ciphertext_hex;
}
sub Decrypt {
- # like encrypt, needs to deal with big blocks. Note that we assume
- # trailing spaces are unimportant.
- my $cipher = shift;
- my $input = shift;
- my ($pos, $portion, $output, $len);
-
- ((length($input) % $blocksize) == 0) || &HTMLError("Password corrupted"); # should always be true...
+ my $hexkey = shift;
+ my $ciphertext_hex = shift;
- for ($pos = 0; $pos < length($input); $pos += $blocksize*2) {
- $portion = pack("H16", substr($input, $pos, $blocksize*2));
- $output .= $cipher->decrypt($portion) if ($hascryptix);
- }
-
- # check length byte, discard junk
- $len = substr($output, 0, 1);
- $output = substr($output, 1, ord($len));
- return $output;
+ my $cipher = Crypt::CBC->new( -key => $hexkey, -cipher => 'Blowfish');
+ my $plaintext = $cipher->decrypt_hex($ciphertext_hex);
+
+ return $plaintext;
}
sub SavePasswordToFile {
my $userid = shift;
my $password = shift;
- my $cipher = shift;
- my $cryptuser = crypt($userid, &CreateCryptSalt);
- my $secret = Encrypt($cipher, $password);
- $cryptuser =~ y/\//_/; # translate slashes to underscores...
-
- my $fn = "$config{authtokenpath}/$cryptuser";
- open (F, ">$fn") || &HTMLError("$fn: $!");
- print F "$secret\n";
- print F time."\n";
- close F;
- chmod 0600, $fn;
- return $cryptuser;
+ my $authtoken = CreateAuthToken($userid);
+ UpdateAuthToken($authtoken, $password);
+ return $authtoken;
}
sub ReadPasswordFromFile {
- my $userid = shift;
- my $cipher = shift;
+ my $authtoken = shift;
+
+ my (undef, $hexkey) = ParseAuthToken($authtoken);
+ my $fn = GetFNfromAuthToken($authtoken);
+
my $passwd;
my $time;
-
- $userid =~ y/\//_/; # translate slashes to underscores...
# if we couldn't read the password file, assume user is unauthenticated. is this ok?
- open (F, "<$config{authtokenpath}/$userid") || return undef;
+ open (F, "<", $fn) || return undef;
chomp($passwd = <F>);
chomp($time = <F>);
close F;
# check to make sure we read something
return undef if (!$passwd || !$time);
-
+
# check to make sure the time is positive, and that the auth token
# has not expired
my $tdiff = (time - $time);
&HTMLError("Your authentication token has expired. Please <a href=\"https://$ENV{SERVER_NAME}/$config{webloginhtml}\">relogin</a>") if (($tdiff < 0) || ($tdiff > $config{authexpires}));
-
- return Decrypt($cipher, $passwd);
+
+ return Decrypt($hexkey, $passwd);
}
-sub CheckAuthToken {
- my ($id, $hrkey) = split(/,/, shift, 2);
- return undef if (!$id || !$hrkey);
- my $key = pack("H".(length($hrkey)), $hrkey);
- my $cipher = new Crypt::Blowfish $key;
- my $r = ReadPasswordFromFile($id, $cipher);
+# given an authtoken and an unencoded username, check that the username matches the
+# encoded and maced username in the authtoken
+sub VerifyCryptedUserMatches {
+ my $authtoken = shift;
+ my $userid = shift;
+
+ my ($crypteduserid, undef) = ParseAuthToken($authtoken);
+
+ $crypteduserid =~ y,_,/,; # reversee translation from slashes to underscores
+ my $res = crypt($userid, $crypteduserid);
+
+ HTMLError("Failed to validate user authtoken\n") unless ($res eq $crypteduserid);
+}
+
+# given an authtoken and username, update lifetime of the authtoken, if it validates.
+sub TouchAuthToken {
+ my $authtoken = shift;
+ my $userid = shift;
+
+ VerifyCryptedUserMatches($authtoken, $userid);
+
+ my $r = ReadPasswordFromFile($authtoken);
if ($r) {
- UpdateAuthToken("$id,$hrkey", $r);
- } else {
- ClearAuthToken("$id,$hrkey")
+ UpdateAuthToken($authtoken, $r);
+ } else {
+ ClearAuthToken($authtoken);
}
return $r;
}
+# clear an authtoken's file from disk, if it validates.
sub ClearAuthToken {
- my ($id, $hrkey) = split(/,/, shift, 2);
- $id =~ y/\//_/; # switch / to _
- unlink "$config{authtokenpath}/$id" || &HTMLError("Error removing authtoken: $!");
+ my $authtoken = shift;
+
+ my $fn = GetFNfromAuthToken($authtoken);
+
+ unlink $fn || &HTMLError("Error removing authtoken: $!");
+}
+
+# Load the base key for our keyed hash function from disk and
+# compute a derived key for use in our HMAC function.
+sub getAuthTokenHMACkey {
+ open (F, "<$config{passdir}/key-hmac-$UID") || &Util::HTMLError($!);
+ my $base_hmac_key = <F>;
+ close(F);
+ chomp($base_hmac_key);
+
+ my $derived_key_hmac = hmac_sha1_hex("authtoken hmac key", $base_hmac_key);
+ return $derived_key_hmac;
+}
+
+# return a Mac (Message Authentication Code) for data.
+sub getDataMac {
+ my $data = shift;
+
+ my $hmac_key = getAuthTokenHMACkey();
+ my $hmac = hmac_sha1_hex($data, $hmac_key);
+
+ return $hmac;
+}
+
+# Given a userid, create an authtoken.
+#
+# The authtoken consists of the encoded username and a key to decrypt the
+# password stored on disk. the authtoken is protected from modification
+# by an hmac.
+sub CreateAuthToken {
+ my $userid = shift;
+
+ my $cryptuser = crypt($userid, CreateCryptSalt(1));
+ $cryptuser =~ y,/,_,; # translate slashes to underscores
+
+ my $key = &Util::CreateKey($config{blowfishkeylen});
+ my $hexkey = unpack("H".($config{blowfishkeylen}*2), $key);
+
+ my $data = "$cryptuser,$hexkey";
+ my $hmac = getDataMac($data);
+ my $authtoken = "$hmac,$data";
+
+ return $authtoken;
}
+# Parse an authtoken into encoded userid and key information and validate its mac.
+sub ParseAuthToken {
+ my $authtoken = shift;
+ my ($hmac_got, $data) = split(/,/, $authtoken, 2);
+ my $hmac_want = getDataMac($data);
+
+ HTMLError("Failed to validate authtoken\n") unless ($hmac_got eq $hmac_want);
+
+ my ($cryptuserid, $hexkey) = split(/,/, $data, 2);
+ return ($cryptuserid, $hexkey);
+}
+
+# Given an authtoken, return the path to the on-disk encrypted session file
+sub GetFNfromAuthToken {
+ my $authtoken = shift;
+ my ($cryptuserid, undef) = ParseAuthToken($authtoken);
+
+ my $fn = "$config{authtokenpath}/$cryptuserid";
+ return $fn;
+}
+
+# Given an authtoken and a password, write the password to disk encrypted by the authtoken's key.
sub UpdateAuthToken {
- my ($id, $hrkey) = split(/,/, shift, 2);
+ my $authtoken = shift;
my $password = shift;
- my $key = pack("H".(length($hrkey)), $hrkey);
- $id =~ y/\//_/; # switch / to _
- my $cipher = new Crypt::Blowfish $key;
- my $secret = Encrypt($cipher, $password);
-
- my $fn = "$config{authtokenpath}/$id";
- open (F, ">$fn") || &HTMLError("$fn: $!");
+ my (undef, $hexkey) = ParseAuthToken($authtoken);
+
+ my $secret = Encrypt($hexkey, $password);
+ my $fn = GetFNfromAuthToken($authtoken);
+
+ my $saveumask = umask 077;
+ open (F, ">", $fn) || &HTMLError("$fn: $!");
print F "$secret\n";
print F time."\n";
close F;
- chmod 0600, "$fn" || &HTMLError("$fn: $!");
+ umask $saveumask;
+
return 1;
}
+
sub FormatFingerPrint {
my $in = shift;
my $out;
$out .= " " if ($_ == 7);
}
} else {
- foreach (0..int(length($in)/2)) {
+ foreach (0..int(length($in)/4)) {
$out .= substr($in, $_*4, 4)." ";
}
}
+ chop $out;
return $out;
}
my ($d1, $d2, $lastseen);
return "<b>No activity detected</b>" if (!$lastseenpgp && !$lastseenfrom);
+ $lastseen = $lastseenpgp;
$lastseen = $lastseenfrom if (!$lastseenpgp);
if ($lastseenfrom && $lastseenpgp) {
- ($d1) = ($lastseenpgp =~ /^\[(.+?)\]/); $d1 = ParseDate($d1);
+ ($d1) = ($lastseenpgp =~ /^\[(.+?)\]/); $d1 = ParseDate($d1);
($d2) = ($lastseenfrom =~ /^\[(.+?)\]/); $d2 = ParseDate($d2);
$lastseen = (($d1 gt $d2) ? $lastseenpgp : $lastseenfrom);
}
- my ($date,$user,$list,$msgid) = ($lastseen =~ /^\[(.+?)\]\s+"(.+?)"\s+"(?:<(.+?)>.*?|\-)"\s+"<(.+?)>"/);
+ my ($date,$user,$list,$msgid) = ($lastseen =~ /^\[(.+?)\]\s+"(.+?)"\s+"(?:<(.+?)>.*?|\-)"\s+"(<.+?>)"/);
$list = "on $list" if ($list);
+ $date = CGI::escapeHTML($date);
+ $user = CGI::escapeHTML($user);
+ $list = CGI::escapeHTML($list);
+ $msgid = CGI::escapeHTML($msgid);
return "$date $list<br> Message ID: $msgid";
}
my $htmlhdrsent = 0;
sub HTMLSendHeader {
- print "Content-type: text/html\n\n" if (!$htmlhdrsent);
+ print "Content-type: text/html; charset=utf-8\n\n" if (!$htmlhdrsent);
$htmlhdrsent = 1;
}
if ((!/^\s*#/) && ($_ ne "")) {
# Chop off any trailing comments
s/#.*//;
- ($attr, $setting) = split(/=/, $_, 2);
+ /([^=]+)=(.*)/;
+ ($attr, $setting) = ($1, $2);
$setting =~ s/"//g; #"
$setting =~ s/;$//;
$attr =~ s/^\s+//; $attr =~ s/\s+$//;
return %config;
}
+sub UpgradeConnection($) {
+ my ($ldap) = @_;
+ my $mesg = $ldap->start_tls(
+ verify => 'require',
+ cafile => $config{sslcafile},
+ );
+ $mesg->sync;
+ if ($mesg->code != LDAP_SUCCESS) {
+ print "Content-type: text/html; charset=utf-8\n\n";
+ print "<html><body><h1>STARTTLS failed: ".$mesg->error."</h1></body></html>\n";
+ exit(1);
+ };
+};
+
+sub readwrite3($$$$) {
+ my ($in, $inputfd, $stdoutfd, $stderrfd) = @_;
+
+ #Echolot::Log::trace("Entering readwrite_gpg.");
+
+ local $INPUT_RECORD_SEPARATOR = undef;
+ my $sout = IO::Select->new();
+ my $sin = IO::Select->new();
+ my $offset = 0;
+
+ #Echolot::Log::trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef').".");
+
+ $inputfd->blocking(0);
+ $stdoutfd->blocking(0);
+ $stderrfd->blocking(0);
+ $sout->add($stdoutfd);
+ $sout->add($stderrfd);
+ $sin->add($inputfd);
+
+ my ($stdout, $stderr) = ("", "", "");
+
+ my ($readyr, $readyw);
+ while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
+ #Echolot::Log::trace("select waiting for ".($sout->count())." fds.");
+ ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, 42);
+ #Echolot::Log::trace("ready: write: ".(defined $readyw ? scalar @$readyw : 'none')."; read: ".(defined $readyr ? scalar @$readyr : 'none'));
+ for my $wfd (@$readyw) {
+ #Echolot::Log::trace("writing to $wfd.");
+ my $written = 0;
+ if ($offset != length($in)) {
+ $written = $wfd->syswrite($in, length($in) - $offset, $offset);
+ }
+ unless (defined ($written)) {
+ #Echolot::Log::warn("Error while writing to GnuPG: $!");
+ close $wfd;
+ $sin->remove($wfd);
+ $sin = undef;
+ } else {
+ $offset += $written;
+ if ($offset == length($in)) {
+ #Echolot::Log::trace("writing to $wfd done.");
+ close $wfd;
+ $sin->remove($wfd);
+ $sin = undef;
+ }
+ }
+ }
+
+ next unless (@$readyr); # Wait some more.
+
+ for my $rfd (@$readyr) {
+ if ($rfd->eof) {
+ #Echolot::Log::trace("reading from $rfd done.");
+ $sout->remove($rfd);
+ close($rfd);
+ next;
+ }
+ #Echolot::Log::trace("reading from $rfd.");
+ if ($rfd == $stdoutfd) {
+ $stdout .= <$rfd>;
+ next;
+ }
+ if ($rfd == $stderrfd) {
+ $stderr .= <$rfd>;
+ next;
+ }
+ }
+ }
+ #Echolot::Log::trace("readwrite_gpg done.");
+ return ($stdout, $stderr);
+};
+
+sub checkPasswordQuality($$$) {
+ my ($pw, $oldpw, $ldapelements) = @_;
+ my ($stdinR, $stdinW) = (IO::Handle->new(), IO::Handle->new());
+ my ($stdoutR, $stdoutW) = (IO::Handle->new(), IO::Handle->new());
+ my ($stderrR, $stderrW) = (IO::Handle->new(), IO::Handle->new());
+ pipe $stdinR, $stdinW;
+ pipe $stdoutR, $stdoutW;
+ pipe $stderrR, $stderrW;
+
+ my $pid = fork();
+ unless (defined $pid) {
+ return (2, "Could not fork: $!");
+ };
+ unless ($pid) { # child
+ $stdinW->close;
+ $stdoutR->close;
+ $stderrR->close;
+ close STDIN;
+ close STDOUT;
+ close STDERR;
+ open (STDIN, "<&".$stdinR->fileno) or warn ("Cannot dup stdinR (fd ".$stdinR->fileno.") as STDIN: $!");
+ open (STDOUT, ">&".$stdoutW->fileno) or warn ("Cannot dup stdoutW (fd ".$stdoutW->fileno.") as STDOUT: $!");
+ open (STDERR, ">&".$stderrW->fileno) or warn ("Cannot dup stderrW (fd ".$stderrW->fileno.") as STDERR: $!");
+ { exec('/usr/lib/userdir-ldap-cgi/password-qualify-check'); }
+ $stderrW->print("Could not exec password-qualify-check: $!\n");
+ exit(1);
+ };
+ $stdinR->close;
+ $stdoutW->close;
+ $stderrW->close;
+
+ $oldpw = '' unless defined $oldpw;
+ my $out = join("\n", $pw, $oldpw, @$ldapelements)."\n";
+ my ($stdout, $stderr) = readwrite3($out, $stdinW, $stdoutR, $stderrR);
+ waitpid $pid, 0;
+
+ my $exitcode = $? >> 8;
+ if ($exitcode == 0 && $stdout eq '' && $stderr eq '') {
+ return (0, "ok");
+ } elsif ($exitcode == 1 && $stderr eq '') {
+ return (1, $stdout);
+ } else {
+ return (2, "check exited with exit code $exitcode, said '$stdout' on stdout, and '$stderr' on stderr.");
+ };
+};
1;
projects / mirror / userdir-ldap-cgi.git / blobdiff