--- /dev/null
+# -*- perl -*-x
+package Util;
+
+use strict;
+use Crypt::Blowfish;
+
+my $blocksize = 8; # A blowfish block is 8 bytes
+my $configfile = "/etc/userdir-ldap/userdir-ldap.conf";
+
+my %config = &ReadConfigFile;
+
+sub CreateKey {
+ my $keysize = shift;
+ my $input;
+ 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 {
+ # this can create either a DES type salt or a MD5 salt
+ my $md5 = shift; # do we want a MD5 salt?
+ 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);
+}
+
+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);
+
+ $input .= " " x ($blocksize - (length($input) % $blocksize)) if (length($input % $blocksize));
+
+ for ($pos = 0; $pos < length($input); $pos += $blocksize) {
+ $output .= unpack("H16", $cipher->encrypt(substr($input, $pos, $blocksize)));
+ }
+ return $output;
+}
+
+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);
+
+ ((length($input) % $blocksize) == 0) || &HTMLError("Password corrupted"); # should always be true...
+
+ for ($pos = 0; $pos < length($input); $pos += $blocksize*2) {
+ $portion = pack("H16", substr($input, $pos, $blocksize*2));
+ $output .= $cipher->decrypt($portion);
+ }
+
+ $output =~ s/ +$//;
+ return $output;
+}
+
+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;
+}
+
+sub ReadPasswordFromFile {
+ my $userid = shift;
+ my $cipher = shift;
+ 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;
+ 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=\"$config{webloginhtml}\">relogin</a>") if (($tdiff < 0) || ($tdiff > $config{authexpires}));
+
+ return Decrypt($cipher, $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);
+ if ($r) {
+ UpdateAuthToken("$id:$hrkey", $r);
+ } else {
+ ClearAuthToken("$id:$hrkey")
+ }
+ return $r;
+}
+
+sub ClearAuthToken {
+ my ($id, $hrkey) = split(/:/, shift, 2);
+ $id =~ y/\//_/; # switch / to _
+ unlink "$config{authtokenpath}/$id" || &HTMLError("Error removing authtoken: $!");
+}
+
+sub UpdateAuthToken {
+ my ($id, $hrkey) = split(/:/, shift, 2);
+ 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: $!");
+ print F "$secret\n";
+ print F time."\n";
+ close F;
+ chmod 0600, "$fn" || &HTMLError("$fn: $!");
+ return 1;
+}
+
+sub FormatFingerPrint {
+ my $in = shift;
+ my $out;
+
+ if (length($in) == 32) {
+ foreach (0..15) {
+ $out .= substr($in, $_*2, 2)." ";
+ $out .= " " if ($_ == 7);
+ }
+ } else {
+ foreach (0..int(length($in)/2)) {
+ $out .= substr($in, $_*4, 4)." ";
+ }
+ }
+ return $out;
+}
+
+sub FetchKey {
+ my $fingerprint = shift;
+ my ($out, $keyringparam);
+
+ foreach (split(/:/, $config{keyrings})) {
+ $keyringparam .= "--keyring $_ ";
+ }
+
+ $fingerprint =~ s/\s//g;
+ $fingerprint = "0x".$fingerprint;
+
+ $/ = undef; # just suck it up ....
+ open(FP, "$config{gpg} $keyringparam --list-sigs --fingerprint $fingerprint|");
+ $out = <FP>;
+ close FP;
+ open(FP, "$config{gpg} $keyringparam --export -a $fingerprint|");
+ $out .= <FP>;
+ close FP;
+ $/ = "\n";
+
+ return $out;
+}
+
+sub FormatTimestamp {
+ my $in = shift;
+ $in =~ /^(....)(..)(..)(..)(..)(..)/;
+
+ return sprintf("%04d/%02d/%02d %02d:%02d:%02d UTC", $1,$2,$3,$4,$5,$6);
+}
+
+sub LookupCountry {
+ my $in = shift;
+ my ($abbrev, $country);
+ open (F, $config{countrylist}) || return uc($in);
+ while (<F>) {
+ chomp;
+ ($abbrev, $country) = split(/\s+/, $_, 2);
+ if ($abbrev eq $in) {
+ close F;
+ return $country;
+ }
+ }
+ close F;
+ return uc($in);
+}
+
+####################
+# Some HTML Routines
+
+my $htmlhdrsent = 0;
+
+sub HTMLSendHeader {
+ print "Content-type: text/html\n\n" if (!$htmlhdrsent);
+ $htmlhdrsent = 1;
+}
+
+sub HTMLPrint {
+ &HTMLSendHeader if (!$htmlhdrsent);
+ print shift;
+}
+
+sub HTMLError {
+ HTMLPrint(shift);
+ die "\n";
+}
+
+sub CheckLatLong {
+ my ($lat, $long) = @_;
+
+ $lat =~ s/[^-+\.\d]//g; $long =~ s/[^-+\.\d]//g;
+
+ if (($lat =~ /^(\-|\+?)\d+(\.\d+)?/) && ($long =~ /^(\-|\+?)\d+(\.\d+)?/)) {
+ return ($lat, $long);
+ } else {
+ return ("", "");
+ }
+}
+
+###################
+# Config file stuff
+sub ReadConfigFile {
+ # reads a config file and results a hashref with the results
+ my (%config, $attr, $setting);
+ open (F, "<$configfile") || &HTMLError("Cannot open $configfile: $!");
+ while (<F>) {
+ chomp;
+ if ((!/^\s*#/) && ($_ ne "")) {
+ # Chop off any trailing comments
+ s/#.*//;
+ ($attr, $setting) = split(/=/, $_, 2);
+ $setting =~ s/"//g;
+ $setting =~ s/;$//;
+ $attr =~ s/^ +//; $attr =~ s/ +$//;
+ $setting =~ s/^ +//; $setting =~ s/ +$//;
+ $config{$attr} = $setting;
+ }
+ }
+ close F;
+ return %config;
+}
+
+1;
--- /dev/null
+To setup apache for use with the web database access scripts use:
+
+<VirtualHost myip>
+ ServerAdmin webmaster@mydomain.com
+ DocumentRoot /var/www/userdir-ldap
+ ServerName db.mydomain.com
+ DirectoryIndex /search.cgi
+</VirtualHost>
+
+<directory /var/www/userdir-ldap>
+ Options +ExecCGI
+ AllowOverride All
+ AddHandler cgi-script .cgi
+</directory>
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use CGI;
+use Util;
+
+# Global settings...
+my %config = &Util::ReadConfigFile;
+
+my $query = new CGI;
+print "Content-type: text/plain\n\n";
+
+my $fp = $query->param('fingerprint');
+
+if ($fp) {
+ my $key = &Util::FetchKey($fp);
+ if ($key) {
+ print $key;
+ } else {
+ print "Sorry, no key found matching fingerprint $fp\n";
+ }
+} else {
+ print "No fingerprint given\n";
+}
+
+exit 0;
+
--- /dev/null
+#!/usr/bin/perl
+
+# (c) 1999 Debian and Randolph Chung. Licensed under the GPL. <tausq@debian.org>
+
+use lib '.';
+use strict;
+#use Apache::Registry;
+use CGI;
+use Util;
+use URI::Escape;
+use Crypt::Blowfish;
+use Net::LDAP qw(:all);
+
+my %config = &Util::ReadConfigFile;
+
+my $query = new CGI;
+my $proto = ($ENV{HTTPS} ? "https" : "http");
+
+if (!($query->param('username')) || !($query->param('password'))) {
+ print "Location: $proto://$ENV{SERVER_NAME}/$config{webloginurl}\n\n";
+ exit;
+}
+
+my $key = &Util::CreateKey($config{blowfishkeylen}); # human-readable version of the key
+my $hrkey = unpack("H".($config{blowfishkeylen}*2), $key);
+my $cipher = new Crypt::Blowfish $key;
+
+my $ldap = Net::LDAP->new($config{ldaphost}) || &Util::HTMLError($!);
+
+my $username = $query->param('username');
+my $password = $query->param('password');
+my $binddn = "uid=$username,$config{basedn}";
+
+my $mesg = $ldap->bind($binddn, password => $password);
+$mesg->sync;
+
+if ($mesg->code == LDAP_SUCCESS) {
+ my $cryptid = &Util::SavePasswordToFile($username, $password, $cipher);
+
+ if ($query->param('update')) {
+ my $url = "$proto://$ENV{SERVER_NAME}/$config{webupdateurl}?id=$username&authtoken=$cryptid:$hrkey&editdn=";
+ $url .= uri_escape("uid=$username,$config{basedn}", "\x00-\x40\x7f-\xff");
+ print "Location: $url\n\n";
+ } else {
+ print "Location: $proto://$ENV{SERVER_NAME}/$config{websearchurl}?id=$username&authtoken=$cryptid:$hrkey\n\n";
+ }
+
+ $ldap->unbind;
+} else {
+ print "Content-type: text/html\n\n";
+ print "<html><body><h1>Not authenticated</h1></body></html>\n";
+}
--- /dev/null
+#!/usr/bin/perl
+
+# (c) 1999 Debian and Randolph Chung. Licensed under the GPL. <tausq@debian.org>
+
+use lib '.';
+use strict vars;
+#use Apache::Registry;
+use CGI;
+use Util;
+use Net::LDAP qw(:all);
+
+my %config = &Util::ReadConfigFile;
+my $proto = ($ENV{HTTPS} ? "https" : "http");
+
+my $query = new CGI;
+my $id = $query->param('id');
+my $authtoken = $query->param('authtoken');
+&Util::ClearAuthToken($authtoken);
+my $doneurl = $query->param('done') || "$config{websearchurl}";
+
+&Util::ClearAuthToken($authtoken);
+
+print "Location: $proto://$ENV{SERVER_NAME}/$doneurl\n\n";
--- /dev/null
+#!/usr/bin/perl
+
+# (c) 1999 Debian and Randolph Chung. Licensed under the GPL. <tausq@debian.org>
+
+use lib '.';
+use strict vars;
+#use Apache::Registry;
+use CGI;
+use Util;
+use URI::Escape;
+use Net::LDAP qw(:all);
+
+# Global settings...
+my %config = &Util::ReadConfigFile;
+
+my $query = new CGI;
+my $id = $query->param('id');
+my $authtoken = $query->param('authtoken');
+my $password = &Util::CheckAuthToken($authtoken);
+my $dosearch = $query->param('dosearch');
+my $searchdn = $query->param('searchdn');
+my $ldap = undef;
+
+my $proto = ($ENV{HTTPS} ? "https" : "http");
+
+sub DieHandler {
+ $ldap->unbind if (defined($ldap));
+}
+
+$SIG{__DIE__} = \&DieHandler;
+
+if (!$dosearch) {
+ # No action yet, send back the search form...
+ print "Content-type: text/html\n\n";
+ open (F, "<$config{websearchhtml}") || &Util::HTMLError($!);
+ while (<F>) {
+ s/~id~/$id/g;
+ s/~authtoken~/$authtoken/g;
+ print;
+ }
+ close F;
+} else {
+ # Go ahead and construct the search terms
+ my %searchdata = (
+ cn => { fuzzy => 'cnfuzzy', formname => 'cn' }, # First name
+ mn => { fuzzy => 'mnfuzzy', formname => 'mn' }, # Middle name
+ sn => { fuzzy => 'snfuzzy', formname => 'sn' }, # Last name
+ email => { fuzzy => 'emailfuzzy', formname => 'email' }, # email
+ uid => { fuzzy => 'uidfuzzy', formname => 'uid' }, # Login name
+ ircnick => { fuzzy => 'ircfuzzy', formname => 'ircnick' }, # IRC nickname
+ keyfingerprint => { fuzzy => 'fpfuzzy', formname => 'fingerprint' }, # PGP/GPG fingerprint
+ c => { formname => 'country'}, # Country
+ );
+
+ # Do a little preprocessing - strip the spaces out of the fingerprint
+ my $temp = $query->param('fingerprint');
+ $temp =~ s/ //g; $query->param('fingerprint', $temp);
+
+ # go through %searchdata and pull out all the search criteria the user
+ # specified...
+ my $filter = undef;
+ foreach (keys(%searchdata)) {
+ if ($query->param($searchdata{$_}{formname})) {
+ if ($query->param($searchdata{$_}{fuzzy})) {
+ # fuzzy search
+ $filter .= "($_~=".$query->param($searchdata{$_}{formname}).")";
+ } else {
+ $filter .= "($_=".$query->param($searchdata{$_}{formname}).")";
+ }
+ }
+ }
+
+ # Vacation is a special case
+ $filter .= "(onvacation=*)" if ($query->param('vacation'));
+
+ # AND all the search terms together
+ $filter = "(&$filter)";
+
+ # Read in the result template...
+ my ($lineref, $dataspecref) = ParseResult($config{websearchresulthtml});
+
+ # Now, we are ready to connect to the LDAP server.
+ $ldap = Net::LDAP->new($config{ldaphost}) || &Util::HTMLError($!);
+ my $auth = 0;
+ my $mesg;
+
+ if ($id && $password) {
+ $mesg = $ldap->bind("uid=$id,$config{basedn}", password => $password);
+ $mesg->sync;
+ $auth = ($mesg->code == LDAP_SUCCESS);
+ }
+
+ if (!$auth) { # Not authenticated - either the above failed, or no password supplied
+ $ldap->bind;
+ }
+
+# &Util::HTMLPrint("Searching in $config{basedn} for $filter...\n");
+
+ $mesg = $ldap->search(base => ($searchdn ? $searchdn : $config{basedn}),
+ filter => ($searchdn ? "(uid=*)" : $filter));
+ $mesg->code && &Util::HTMLError($mesg->error);
+
+ my %outsub; # this hash will contain all the substitution tokens in the output
+ $outsub{count} = $mesg->count; # Count number of requests, also ensures we're done with the search
+ $outsub{auth} = $authtoken;
+ $outsub{authtoken} = $authtoken; # alias
+ $outsub{id} = $id;
+ $outsub{searchresults} = undef;
+
+ my $entries = $mesg->as_struct; # entries contain a hashref to all the search results
+ my ($dn, $attr, $data);
+
+ # Format the output....
+ foreach $dn (sort {$entries->{$a}->{sn}->[0] <=> $entries->{$b}->{sn}->[0]} keys(%$entries)) {
+ $data = $entries->{$dn};
+
+ # These are local variables.. i have enough global vars as it is... <sigh>
+ my ($ufdn, $login, $name, $email, $fingerprint, $address, $latlong, $vacation, $created, $modified) = undef;
+
+ $ufdn = $dn; # Net::LDAP does not have a dn2ufn function, but this is close enough :)
+
+ # Assemble name, attach web page link if present.
+ $name = $data->{cn}->[0]." ".$data->{mn}->[0]." ".$data->{sn}->[0];
+ if (my $url = $data->{labeledurl}->[0]) {
+ $name = "<a href=\"$url\">$name</a>";
+ }
+
+ # Add links to all email addresses
+ foreach (@{$data->{emailforward}}) {
+ $email .= "<br>" if ($email);
+ $email .= "<a href=\"mailto:$_\">$_</a>";
+ }
+
+ # Format PGP/GPG key fingerprints
+ my $fi;
+ foreach (@{$data->{keyfingerprint}}) {
+ $fingerprint .= "<br>" if ($fingerprint);
+ $fingerprint .= sprintf("%d:- <a href=\"fetchkey.cgi?fingerprint=%s\">%s</a>", ++$fi, $_, &Util::FormatFingerPrint($_));
+ }
+
+ # Assemble addresses
+ $address = $data->{postaladdress}->[0] || "- unlisted -";
+ $address =~ s/\$/<br>/g;
+ $address .= "<br>".$data->{l}->[0]."<br>".&Util::LookupCountry($data->{c}->[0])."<br>".$data->{postalcode}->[0];
+
+ # Assemble latitude/longitude
+ $latlong = $data->{latitude}->[0] || "none";
+ $latlong .= " / ";
+ $latlong .= $data->{longitude}->[0] || "none";
+
+ # Modified/created time. TODO: maybe add is the name of the creator/modifier
+ $modified = &Util::FormatTimestamp($data->{modifytimestamp}->[0]);
+ $created = &Util::FormatTimestamp($data->{createtimestamp}->[0]);
+
+ # Link in the debian login id
+ $login = $data->{uid}->[0]."\@debian.org";
+ $login = "<a href=\"mailto:$login\">$login</a>";
+
+ # See if the user has a vacation message
+ $vacation = $data->{onvacation}->[0];
+
+ # OK, now generate output... (i.e. put the output into the buffer )
+ $outsub{searchresults} .= '<table border=2 cellpadding=2 cellspacing=0 bgcolor="#DDDDDD" width="80%">';
+ $outsub{searchresults} .= '<tr><th bgcolor="#44CCCC" colspan=2><font size=+1>'."$name</font> ";
+ $outsub{searchresults} .= "($ufdn)</th></tr>\n";
+
+ if ($vacation) {
+ $outsub{searchresults} .= "<tr><td colspan=2 align=center><b>$vacation</b></td></tr>\n";
+ }
+
+ $outsub{searchresults} .= FormatEntry($dataspecref->{uid}, $login);
+ $outsub{searchresults} .= FormatEntry($dataspecref->{ircnick}, $data->{ircnick}->[0]);
+ $outsub{searchresults} .= FormatEntry($dataspecref->{loginshell}, $data->{loginshell}->[0]);
+ $outsub{searchresults} .= FormatEntry($dataspecref->{fingerprint}, $fingerprint);
+
+ if ($auth) {
+ # Some data should only be available to authorized users...
+ if ($id eq $data->{uid}->[0]) {
+ $outsub{searchresults} .= FormatEntry($dataspecref->{email}, $email);
+ }
+ $outsub{searchresults} .= FormatEntry($dataspecref->{address}, $address);
+ $outsub{searchresults} .= FormatEntry($dataspecref->{latlong}, $latlong);
+ $outsub{searchresults} .= FormatEntry($dataspecref->{phone}, $data->{telephonenumber}->[0] || "- unlisted -");
+ $outsub{searchresults} .= FormatEntry($dataspecref->{fax}, $data->{fascimiletelephonenumber}->[0] || "- unlisted -");
+ }
+ $outsub{searchresults} .= FormatEntry($dataspecref->{created}, $created);
+ $outsub{searchresults} .= FormatEntry($dataspecref->{modified}, $modified);
+
+ $outsub{searchresults} .= "</table>";
+
+ # If this is ourselves, present a link to do mods
+ if ($auth && ($id eq $data->{uid}->[0])) { #TODO: extract this string into a url for translation...
+ $outsub{searchresults} .= "<a href=\"$proto://$ENV{SERVER_NAME}/$config{webupdateurl}?id=$id&authtoken=$authtoken&editdn=".uri_escape($dn, "\x00-\x40\x7f-\xff")."\">Edit my settings</a>\n";
+ }
+
+ $outsub{searchresults} .= "<br><br><br>\n";
+ }
+
+ # Finally, we can write the output... yuck...
+ &Util::HTMLSendHeader;
+ foreach (@$lineref) {
+ if (/<\?ifauth(.+?)\?>/) {
+ $_ = ($auth ? $1 : "");
+ } elsif (/<\?ifnoauth(.+?)\?>/) {
+ $_ = ($auth ? "" : $1);
+ }
+ s/~(.+?)~/$outsub{$1}/g;
+ print;
+ }
+
+ $ldap->unbind;
+}
+
+sub ParseResult {
+ # Reads the output html file and find out how the output should be named
+ # -- this gives us a way to do translations more easily
+ # Returns the contents of the template (w/o the searchresult portion) and
+ # the output specification
+ my $fn = shift;
+ my $insec = 0;
+ my @lines;
+ my %hash;
+
+ open (F, "<$fn") || &Util::HTMLError("$fn: $!");
+ while (<F>) {
+ if (!$insec) {
+ if (/<\?searchresults/i) {
+ $insec = 1;
+ push(@lines, "~searchresults~\n"); # Leave token so we know where to put the result
+ } else {
+ push(@lines, $_);
+ }
+ } else {
+ if (/searchresults\?>/i) {
+ $insec = 0;
+ } else {
+ if (!/^\s*#/) {
+ s/^ *\(//;
+ s/\) *$//; # remove leading/trailing () and spaces
+ chomp;
+ my ($desc, $attr) = split(/, /, $_, 2);
+ $hash{$attr} = $desc;
+ }
+ }
+ }
+ }
+ close F;
+ return (\@lines, \%hash);
+}
+
+sub FormatEntry {
+ my ($key, $val) = @_;
+
+ return "<tr><td align=right><b>$key:</b></td><td> $val</td></tr>\n";
+}
--- /dev/null
+#!/usr/bin/perl
+
+# (c) 1999 Debian and Randolph Chung. Licensed under the GPL. <tausq@debian.org>
+
+use lib '.';
+use strict vars;
+#use Apache::Registry;
+use CGI;
+use Util;
+use URI::Escape;
+use Net::LDAP qw(:all);
+
+my %config = &Util::ReadConfigFile;
+
+my $query = new CGI;
+my $proto = ($ENV{HTTPS} ? "https" : "http");
+
+my $id = $query->param('id');
+my $authtoken = $query->param('authtoken');
+my $password = &Util::CheckAuthToken($authtoken);
+my $editdn = $query->param('editdn');
+
+if (!($id && $password)) {
+ print "Location: $proto://$ENV{SERVER_NAME}/$config{webloginurl}\n\n";
+ exit;
+}
+
+my $ldap;
+
+sub DieHandler {
+ $ldap->unbind if (defined($ldap));
+}
+
+$SIG{__DIE__} = \&DieHandler;
+
+$ldap = Net::LDAP->new($config{ldaphost});
+my $auth = 0;
+my $mesg;
+$mesg = $ldap->bind($editdn, password => $password);
+$mesg->sync;
+$auth = ($mesg->code == LDAP_SUCCESS);
+
+if (!$auth) {
+ $ldap->unbind;
+ &Util::HTMLError("You have not been authenticated. Please <a href=\"$proto://$ENV{SERVER_NAME}/$config{webloginurl}\">Login</a>");
+}
+
+# Authenticated....
+# Get our entry...
+$mesg = $ldap->search(base => $editdn,
+ filter => "uid=*");
+$mesg->code && &Util::HTMLError($mesg->error);
+
+my $entries = $mesg->as_struct;
+if ($mesg->count != 1) {
+ # complain and quit
+}
+
+my @dns = keys(%$entries);
+my $entry = $entries->{$dns[0]};
+
+if (!($query->param('doupdate'))) {
+ # Not yet update, just fill in the form with the current values
+ my %data;
+
+ # Fill in %data
+ # First do the easy stuff - this catches most of the cases
+ foreach (keys(%$entry)) {
+ $data{$_} = $entry->{$_}->[0];
+ }
+
+ # Now we have to fill in the rest that needs some processing...
+ $data{id} = $id;
+ $data{authtoken} = $authtoken;
+ $data{editdn} = $editdn;
+ $data{staddress} = $entry->{postaladdress}->[0];
+ $data{staddress} =~ s/\$/\n/;
+ $data{countryname} = &Util::LookupCountry($data{c});
+
+ $data{email} = join(", ", @{$entry->{emailforward}});
+
+ # finally we can send output...
+ my ($sub, $substr);
+ &Util::HTMLSendHeader;
+ open (F, "<$config{webupdatehtml}") || &Util::HTMLError($!);
+ while (<F>) {
+ s/~(.+?)~/$data{$1}/g;
+ print;
+ }
+ close F;
+
+} else {
+ # Actually update stuff...
+ my ($newpassword, $newstaddress);
+
+ if ($query->param('newpass') && $query->param('newpassvrfy')) {
+ if ($query->param('newpass') ne $query->param('newpassvrfy')) {
+ # passwords don't match...
+ &Util::HTMLError("The passwords you specified do not match. Please go back and try again.");
+ }
+ # create a md5 crypted password
+ $newpassword = '{crypt}'.crypt($query->param('newpass'), &Util::CreateCryptSalt(1));
+
+ LDAPUpdate($ldap, $editdn, 'userPassword', $newpassword);
+ &Util::UpdateAuthToken($authtoken, $query->param('newpass'));
+ }
+
+ $newstaddress = $query->param('staddress');
+ $newstaddress =~ s/\n/\$/m;
+
+ my ($lat, $long);
+ ($lat, $long) = &Util::CheckLatLong($query->param('latitude'),
+ $query->param('longitude'));
+
+ LDAPUpdate($ldap, $editdn, 'postalAddress', $newstaddress);
+ LDAPUpdate($ldap, $editdn, 'l', $query->param('l'));
+ LDAPUpdate($ldap, $editdn, 'latitude', $lat);
+ LDAPUpdate($ldap, $editdn, 'longitude', $long);
+ LDAPUpdate($ldap, $editdn, 'c', $query->param('country'));
+ LDAPUpdate($ldap, $editdn, 'postalcode', $query->param('postalcode'));
+ LDAPUpdate($ldap, $editdn, 'telephoneNumber', $query->param('telephonenumber'));
+ LDAPUpdate($ldap, $editdn, 'facsimileTelephoneNumber', $query->param('facsimiletelephonenumber'));
+ LDAPUpdate($ldap, $editdn, 'loginShell', $query->param('loginshell'));
+ LDAPUpdate($ldap, $editdn, 'emailForward', $query->param('email'));
+ LDAPUpdate($ldap, $editdn, 'privatesub', $query->param('privatesub'));
+ LDAPUpdate($ldap, $editdn, 'ircNick', $query->param('ircnick'));
+ LDAPUpdate($ldap, $editdn, 'labeledUrl', $query->param('labeledurl'));
+ LDAPUpdate($ldap, $editdn, 'onvacation', $query->param('onvacation'));
+
+ # when we are done, reload the page with the updated details.
+ my $url = "$proto://$ENV{SERVER_NAME}/$config{webupdateurl}?id=$id&authtoken=$authtoken&editdn=";
+ $url .= uri_escape($editdn, "\x00-\x40\x7f-\xff");
+ print "Location: $url\n\n";
+}
+
+$ldap->unbind;
+
+sub LDAPUpdate {
+ my $ldap = shift;
+ my $dn = shift;
+ my $attr = shift;
+ my $val = shift;
+ my $mesg;
+
+ if (!$val) {
+ $mesg = $ldap->modify($dn, delete => { $attr => [] });
+ } else {
+ $val = [ $val ] if (!ref($val));
+ $mesg = $ldap->modify($dn, replace => { $attr => $val });
+ $mesg->code && &Util::HTMLError("error updating $attr: ".$mesg->error);
+ }
+}
projects / mirror / userdir-ldap-cgi.git / commitdiff