1#!/usr/bin/perl
2# Copyright (c) 2012-2014 Synergetics SA (sampo@synergetics.be), All Rights Reserved.
3# Copyright (c) 2010 Sampo Kellomaki (sampo@iki.fi), All Rights Reserved.
4# This is confidential unpublished proprietary source code of the author.
5# NO WARRANTY, not even implied warranties. Contains trade secrets.
6# Distribution prohibited unless authorized in writing.
7# Licensed under Apache License 2.0, see file COPYING.
8# $Id$
9#
10# 9.2.2014, created based on zxidnewuser.pl --Sampo
11#
12# Web GUI for recovering password, possibly in middle of login sequence.
13# The AuthnRequest is preserved through new user creation by passing ar.
14
15$from = 'sampo-noreplybot@zxid.org';
16$admin_mail = 'sampo-pwadm@zxid.org';
17$dir = '/var/zxid/idp';
18
19$usage = <<USAGE;
20Web GUI for creating new user, possibly in middle of login sequence.
21Usage: http://localhost:8081/zxidrecoverpw.pl?QUERY_STRING
22       ./zxidrecoverpw.pl -a QUERY_STRING
23         -a Ascii mode
24USAGE
25    ;
26die $usage if $ARGV[0] =~ /^-[Hh?]/;
27
28use Data::Dumper;
29use MIME::Base64;
30
31close STDERR;
32open STDERR, ">>/var/tmp/zxid.stderr" or die "Cant open error log: $!";
33select STDERR; $|=1; select STDOUT;
34
35($sec,$min,$hour,$mday,$mon,$year) = gmtime(time);
36$ts = sprintf "%04d%02d%02d-%02d%02d%02d", $year+1900, $mon+1, $mday, $hour, $min, $sec;
37#warn "$$: START $ts env: " . Dumper(\%ENV);
38
39$ENV{QUERY_STRING} ||= shift;
40cgidec($ENV{QUERY_STRING});
41
42if ($ENV{CONTENT_LENGTH}) {
43    sysread STDIN, $data, $ENV{CONTENT_LENGTH};
44    #warn "GOT($data) $ENV{CONTENT_LENGTH}";
45    cgidec($data);
46}
47warn "$$: cgi: " . Dumper(\%cgi);
48
49sub uridec {
50    my ($val) = @_;
51    $val =~ s/\+/ /g;
52    $val =~ s/%([0-9a-f]{2})/chr(hex($1))/gsexi;  # URI decode
53    return $val;
54}
55
56sub urienc {
57    my ($val) = @_;
58    $val =~ s/([^A-Za-z0-9.,_-])/sprintf("%%%02x",ord($1))/gsex; # URI enc
59    return $val;
60}
61
62sub cgidec {
63    my ($d) = @_;
64    for $nv (split '&', $d) {
65	($n, $v) = split '=', $nv, 2;
66	$cgi{$n} = uridec($v);
67    }
68}
69
70sub readall {
71    my ($f) = @_;
72    my ($pkg, $srcfile, $line) = caller;
73    undef $/;         # Read all in, without breaking on lines
74    open F, "<$f" or warn "$srcfile:$line: Cant read($f): $!";
75    binmode F;
76    my $x = <F>;
77    close F;
78    return $x;
79}
80
81sub show_templ {
82    my ($templ, $hr) = @_;
83    $templ = readall($templ);
84    $templ =~ s/!!(\w+)/$$hr{$1}/gs;
85    my $len = length $templ;
86    syswrite STDOUT, "Content-Type: text/html\r\nContent-Length: $len\r\n\r\n$templ";
87    exit;
88}
89
90sub redirect {
91    my ($url) = @_;
92    syswrite STDOUT, "Location: $url\r\n\r\n";
93    exit;
94}
95
96sub send_mail {
97    my ($to, $subj, $body) = @_;
98    open S, "|/usr/sbin/sendmail -i -B 8BITMIME -t" or do { warn "No /usr/sbin/sendmail: $! $? (apt-get install nullmailer)"; return; } ;
99    $msg = <<MAIL;
100From: $from
101To: $to
102Subject: $subj
103MIME-Version: 1.0
104Content-Type: text/plain; charset=ISO-8859-1
105Content-Transfer-Encoding: 8bit
106
107$body
108MAIL
109;
110    warn "msg($msg)";
111    print S $msg;
112    close S;
113}
114
115sub send_detail {
116    my ($subj) = @_;
117    send_mail($admin_mail, $subj, <<BODY);
118intervention: $cgi{'ivent'}
119uid: $cgi{'au'}
120pw: $pw
121ip: $ENV{REMOTE_ADDR}
122email: $cgi{'email'}
123im: $cgi{'im'}
124tel: $cgi{'tel'}
125
126Comments or special requests:
127$cgi{'comment'}
128
129Attributes:
130$at
131EOF
132BODY
133    ;
134}
135
136sub zxpasswd {
137    my ($pw) = @_;
138    open P, "|./zxpasswd $cgi{'au'} ${dir}uid" or die "Cant open pipe to zxpasswd: $! $?";
139    print P $pw;
140    close P;
141}
142
143### MAIN
144
145if (length $cgi{'continue'}) {
146    if ($cgi{'zxidpurl'} && $cgi{'zxrfr'} && $cgi{'ar'}) {
147	warn "Redirecting back to IdP";
148	redirect("$cgi{'zxidpurl'}?o=$cgi{'zxrfr'}&ar=$cgi{'ar'}");
149    } else {
150	warn "Redirecting back to index page.";
151	redirect("/");
152    }
153}
154
155if (length $cgi{'pwreset'} && length $cgi{'au'}) {
156    $pwreset = readall("${dir}uid/$cgi{'au'}/.pwreset");
157    unlink "${dir}uid/$cgi{'au'}/.pwreset";  # one time use only
158    (undef, $expires_secs, $user, $ip) = split /\s+/, $pwreset;
159    if ($expires_secs >= time()) {
160	if ($user eq $cgi{'au'}) {
161	    open R, "</dev/urandom" or die "Cant open read /dev/urandom: $!";
162	    sysread R, $pw, 9;
163	    close R;
164	    $pw = encode_base64($pw,'');
165	    zxpasswd($pw);
166	    send_detail("PW picked up ok, reset $cgi{'au'}");
167
168	    $cgi{'PW'} = $pw;
169	    $cgi{'ip'} = $ENV{REMOTE_ADDR};
170	    show_templ("recoverpw-reset.html", \%cgi);
171	} else {
172	    warn "The user from URL($cgi{'au'}) does not match user from pwreset token($user)";
173	    $cgi{ERR} = "User mismatch.";
174	    send_detail("PW pickup user mismatch $cgi{'au'}");
175	}
176    } else {
177	warn "Password reset token has expired. now=".time()." > expiry=$expires_secs";
178	$cgi{ERR} = "Password reset token has expired or already used (they can only be used once). You need to trigger the reset again.";
179	send_detail("PW pickup expiry $cgi{'au'}");
180    }
181}
182
183if (length $cgi{'ok'}) {
184    if ($cgi{'ivent'} ne 'block' && $cgi{'ivent'} ne 'human' && $cgi{'ivent'} ne 'auto') {
185	warn "No intervention chosen. Redirecting back to index page.";
186	redirect("/");
187    }
188
189    if (length $cgi{'au'} < 3 || length $cgi{'au'} > 40) {
190	$cgi{'ERR'} = "Username must be at least 3 characters long (and no longer than 40 chars).";
191    } elsif ($cgi{'au'} !~ /^[A-Za-z0-9_-]+$/s) {
192	$cgi{'ERR'} = "Username can only contain characters [A-Za-z0-9_-]";
193    } elsif (! -e "${dir}uid/$cgi{'au'}") {
194	$cgi{'ERR'} = "Username not known.";
195    } else {
196	$cgi{ERR} = undef;
197	warn "Reset password for user($cgi{'au'})";
198
199	open R, "</dev/urandom" or die "Cant open read /dev/urandom: $!";
200	sysread R, $pw, 9;
201	close R;
202	$pw = encode_base64($pw,'');
203
204	$at =  readall("${dir}uid/$cgi{'au'}/.bs/.at");
205	$at .= readall("${dir}uid/$cgi{'au'}/.bs/.optat");
206	($email) = $at =~ /^email:\s+(\S+)$/m;
207	$human = readall("${dir}uid/$cgi{'au'}/.human");
208
209	open LOG, ">>${dir}uid/$cgi{'au'}/.log" or die "Cant open write .log: $!";
210	print LOG "$ts Password reset for $cgi{'au'} email($email) ivent($cgi{'ivent'}) ($human) ip=$ENV{REMOTE_ADDR}\n" or die "Cant write .log: $!";
211	close LOG or die "Cant close write .log: $!";
212
213	if ($human >= 1 || $cgi{'ivent'} eq 'human') {
214	    send_detail("PW Reset or Block Human $cgi{'au'}");
215	} elsif ($cgi{'ivent'} eq 'block') {
216	    zxpasswd($pw);
217	    $pw = '(omitted)';
218	    send_detail("PW Block $cgi{'au'}");
219	} elsif ($cgi{'ivent'} eq 'auto' && $email) {
220	    zxpasswd($pw);
221	    $pw = '(omitted)';
222	    send_detail("PW Block pending password pickup $cgi{'au'}");
223
224	    open R, "</dev/urandom" or die "Cant open read /dev/urandom: $!";
225	    sysread R, $pwurl, 9;
226	    close R;
227	    $pwurl = encode_base64($pwurl,'');
228
229	    $expires_secs = time()+84600;
230	    open PWRESET, ">${dir}uid/$cgi{'au'}/.pwreset" or die "Cant open write .pwreset: $!";
231	    print PWRESET "PWRESET $expires_secs $cgi{'au'} $ENV{REMOTE_ADDR} email($email)\n" or die "Cant write .pwreset: $!";
232	    close PWRESET or die "Cant close write .pwreset: $!";
233
234	    #$pwurl = ($ENV{HTTPS}eq'on'?'https':'http')."://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}?au=$cgi{'au'}&pwreset=$pwurl";
235	    $pwurl = (1?'https':'http')."://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}?au=$cgi{'au'}&pwreset=$pwurl";
236
237	    $template = readall("recoverpw-main.html");
238	    ($templ) = $template =~ /<!--EMAIL_BODY(.*)END_EMAIL_BODY-->/s;
239	    warn "Next step pwurl($pwurl) template($template) templ($templ)";
240	    $templ =~ s/!!pwurl/$pwurl/g;
241	    send_mail($email, "Password reset", $templ);
242	}
243
244	if ($cgi{'zxidpurl'} && $cgi{'zxrfr'} && $cgi{'ar'}) {
245	    warn "Password reset for user($cgi{'au'})";
246	    $cgi{MSG} = "Success! Password reset for user $cgi{'au'}. Check your email (including spam folder). Click Continue to get back to IdP login.";
247	    show_templ("newuser-status.html", \%cgi);
248	} else {
249	    warn "Password reset for user($cgi{'au'}, back to top)";
250	    $cgi{MSG} = "Success! Password reset for user $cgi{'au'}. Check your email (including spam folder). Click Continue to get back to top.";
251	    show_templ("newuser-status.html", \%cgi);
252	}
253    }
254}
255
256$cgi{'ip'} = $ENV{REMOTE_ADDR};
257show_templ("recoverpw-main.html", \%cgi);
258
259__END__
260