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# 8.3.2010, created --Sampo 11# 5.2.2012, changed zxpasswd to use -n instead of -c --Sampo 12# 9.2.2014, changed to use zxpasswd -new 13# 14# Web GUI for creating new user, possibly in middle of login sequence. 15# The AuthnRequest is preserved through new user creation by passing ar. 16 17$from = 'sampo-pwbot-noreply@zxid.org'; 18$admin_mail = 'sampo-pwadm@zxid.org'; 19$dir = '/var/zxid/idp'; 20 21$usage = <<USAGE; 22Web GUI for creating new user, possibly in middle of login sequence. 23Usage: http://localhost:8081/zxidnewuser.pl?QUERY_STRING 24 ./zxidnewuser.pl -a QUERY_STRING 25 -a Ascii mode 26 -t Test mode 27USAGE 28 ; 29die $usage if $ARGV[0] =~ /^-[Hh?]/; 30if ($ARGV[0] eq '-t') { 31 warn "Sending..."; 32 send_detail("Test $$"); 33 exit; 34} 35 36use Data::Dumper; 37use MIME::Base64; 38 39close STDERR; 40open STDERR, ">>/var/tmp/zxid.stderr" or die "Cant open error log: $!"; 41select STDERR; $|=1; select STDOUT; 42 43($sec,$min,$hour,$mday,$mon,$year) = gmtime(time); 44$ts = sprintf "%04d%02d%02d-%02d%02d%02d", $year+1900, $mon+1, $mday, $hour, $min, $sec; 45#warn "$$: START env: " . Dumper(\%ENV); 46 47$ENV{QUERY_STRING} ||= shift; 48cgidec($ENV{QUERY_STRING}); 49 50if ($ENV{CONTENT_LENGTH}) { 51 sysread STDIN, $data, $ENV{CONTENT_LENGTH}; 52 #warn "GOT($data) $ENV{CONTENT_LENGTH}"; 53 cgidec($data); 54} 55warn "$$: cgi: " . Dumper(\%cgi); 56 57sub uridec { 58 my ($val) = @_; 59 $val =~ s/\+/ /g; 60 $val =~ s/%([0-9a-f]{2})/chr(hex($1))/gsexi; # URI decode 61 return $val; 62} 63 64sub urienc { 65 my ($val) = @_; 66 $val =~ s/([^A-Za-z0-9.,_-])/sprintf("%%%02x",ord($1))/gsex; # URI enc 67 return $val; 68} 69 70sub cgidec { 71 my ($d) = @_; 72 for $nv (split '&', $d) { 73 ($n, $v) = split '=', $nv, 2; 74 $cgi{$n} = uridec($v); 75 } 76} 77 78sub readall { 79 my ($f) = @_; 80 my ($pkg, $srcfile, $line) = caller; 81 undef $/; # Read all in, without breaking on lines 82 open F, "<$f" or die "$srcfile:$line: Cant read($f): $!"; 83 binmode F; 84 my $x = <F>; 85 close F; 86 return $x; 87} 88 89sub show_templ { 90 my ($templ, $hr) = @_; 91 $templ = readall($templ); 92 $templ =~ s/!!(\w+)/$$hr{$1}/gs; 93 my $len = length $templ; 94 syswrite STDOUT, "Content-Type: text/html\r\nContent-Length: $len\r\n\r\n$templ"; 95 exit; 96} 97 98sub redirect { 99 my ($url) = @_; 100 syswrite STDOUT, "Location: $url\r\n\r\n"; 101 exit; 102} 103 104sub send_mail { 105 my ($to, $subj, $body) = @_; 106 open S, "|/usr/sbin/sendmail -i -B 8BITMIME -t" or die "No sendmail in path: $! $?"; 107 $msg = <<MAIL; 108From: $from 109To: $to 110Subject: $subj 111MIME-Version: 1.0 112Content-Type: text/plain; charset=ISO-8859-1 113Content-Transfer-Encoding: 8bit 114 115$body 116MAIL 117; 118 warn "msr($msg)"; 119 print S $msg; 120 close S; 121} 122 123sub send_detail { 124 my ($subj) = @_; 125 send_mail($admin_mail, $subj, <<BODY); 126uid: $cgi{'au'} 127ip: $ENV{REMOTE_ADDR} 128title: $cgi{'title'} 129o: $cgi{'o'} 130ou: $cgi{'ou'} 131email: $cgi{'email'} 132im: $cgi{'im'} 133tel: $cgi{'tel'} 134tag: $cgi{'tag'} 135 136Comments or special requests: 137$cgi{'comment'} 138BODY 139 ; 140} 141 142if (length $cgi{'continue'}) { 143 if ($cgi{'zxidpurl'} && $cgi{'zxrfr'} && $cgi{'ar'}) { 144 warn "Redirecting back to IdP"; 145 redirect("$cgi{'zxidpurl'}?o=$cgi{'zxrfr'}&ar=$cgi{'ar'}"); 146 } else { 147 warn "Redirecting back to index page."; 148 redirect("/"); 149 } 150} 151 152### MAIN 153 154if (length $cgi{'ok'}) { 155 if (length $cgi{'au'} < 3 || length $cgi{'au'} > 40) { 156 $cgi{'ERR'} = "Username must be at least 3 characters long (and no longer than 40 chars)."; 157 } elsif ($cgi{'au'} !~ /^[A-Za-z0-9_-]+$/s) { 158 $cgi{'ERR'} = "Username can only contain characters [A-Za-z0-9_-]"; 159 } elsif (length $cgi{'ap'} < 5 || length $cgi{'ap'} > 80) { 160 $cgi{'ERR'} = "Password must be at least 5 characters long (and no longer than 80 chars)."; 161 } elsif (-e "${dir}uid/$cgi{'au'}") { 162 $cgi{'ERR'} = "Username already taken."; 163 } else { 164 warn "Creating new user($cgi{'au'})"; 165 open P, "|./zxpasswd -new $cgi{'au'} ${dir}uid" or die "Cant open pipe to zxpasswd: $! $?"; 166 print P $cgi{'ap'}; 167 close P; 168 warn "Populating user($cgi{'au'})"; 169 if (-e "${dir}uid/$cgi{'au'}") { 170 open LOG, ">${dir}uid/$cgi{'au'}/.log" or die "Cant open write .log: $!"; 171 print LOG "$ts Created $cgi{'au'} ip=$ENV{REMOTE_ADDR}\n" or die "Cant write .log: $!"; 172 close LOG or die "Cant close write .log: $!"; 173 174 open IP, ">${dir}uid/$cgi{'au'}/.regip" or die "Cant open write .regip: $!"; 175 print IP $ENV{REMOTE_ADDR} or die "Cant write .regip: $!"; 176 close IP or die "Cant close write .regip: $!"; 177 178 if ($cgi{'humanintervention'} > 0) { 179 open HUMAN, ">${dir}uid/$cgi{'au'}/.human" or die "Cant open write .human: $!"; 180 print HUMAN $cgi{'humanintervention'} or die "Cant write .human: $!"; 181 close HUMAN or die "Cant close write .human: $!"; 182 } 183 #mkdir "${dir}uid/$cgi{'au'}/.bs" or warn "Cant mkdir .bs: $!"; zxpasswd creates .bs 184 open AT, ">${dir}uid/$cgi{'au'}/.bs/.at" or die "Cant write .bs/.at: $!"; 185 open OPTAT, ">${dir}uid/$cgi{'au'}/.bs/.optat" or die "Cant write .bs/.optat: $!"; 186 187 for $at (qw(cn title taxno o ou street citystc email im tel lang tag)) { 188 $val = $cgi{$at}; 189 $val =~ s/[\r\n]//g; 190 next if !length $val; 191 if ($cgi{"${at}share"}) { 192 print AT "$at: $val\n"; 193 } else { 194 print OPTAT "$at: $val\n"; 195 } 196 } 197 198 close AT; 199 close OPTAT; 200 201 send_detail("New User $cgi{'au'}"); 202 203 if ($cgi{'zxidpurl'} && $cgi{'zxrfr'} && $cgi{'ar'}) { 204 warn "Created user($cgi{'au'})"; 205 $cgi{MSG} = "Success! Created user $cgi{'au'}. Click Continue to get back to IdP login."; 206 show_templ("newuser-status.html", \%cgi); 207 } else { 208 warn "Created user($cgi{'au'})"; 209 $cgi{MSG} = "Success! Created user $cgi{'au'}. Click Continue to get back to top."; 210 show_templ("newuser-status.html", \%cgi); 211 } 212 } else { 213 $cgi{'ERR'} = "User creation failed. System error (${dir}uid/$cgi{'au'})."; 214 } 215 } 216} 217 218$cgi{'humaninterventionchecked'} = $cgi{'humanintervention'} eq '1' ? ' checked':''; 219$cgi{'ip'} = $ENV{REMOTE_ADDR}; 220if (!length $cgi{'ap'}) { 221 open R, "</dev/urandom" or die "Cant open read /dev/urandom: $!"; 222 sysread R, $pw, 9; 223 close R; 224 $cgi{'ap'} = encode_base64($pw,''); # Just a suggestion 225} 226show_templ("newuser-main.html", \%cgi); 227 228__END__ 229