diff options
| -rwxr-xr-x | setup.pl | 41 | ||||
| -rw-r--r-- | www/common.pl | 24 | ||||
| -rwxr-xr-x | www/logged_in_p.pl | 13 | ||||
| -rwxr-xr-x | www/login.pl | 23 | ||||
| -rwxr-xr-x | www/sign.pl | 25 |
5 files changed, 84 insertions, 42 deletions
@@ -11,6 +11,19 @@ use File::Copy; use LWP::Simple qw(getstore); use Data::Dumper; +sub prompt($$) { + my ($question, $default) = @_; + $|++; + print "${question} \[${default}\] "; + $_ = <>; + chomp; + if ($_) { + return $_; + } else { + return $default; + } +} + sub printspec($$) { my ($outfile, $key) = @_; my ($n, $e, @stuff) = $key->get_key_parameters; @@ -23,13 +36,24 @@ sub printspec($$) { my $conffile = "www/config.pl"; # Generate configuration file. -our $MULKONF = { }; +$::MULKONF = { }; if (stat($conffile)) { say "Found existing configuration ($conffile)."; do $conffile; } -my $configpath = $MULKONF->{configpath} // "etc/mulkyid"; -my $pemfile = $MULKONF->{pemfile} // "$configpath/rsa2048.pem"; + +my $configpath = $::MULKONF->{configpath} // "/etc/mulkyid"; +$configpath = prompt("Where shall I put configuration files?", $configpath); +my $pemfile = $::MULKONF->{pemfile} // "$configpath/rsa2048.pem"; +$pemfile = prompt("Where shall I put the private key?", $pemfile); +my $aliases_file = $::MULKONF->{aliases_file} // "/etc/aliases"; +$aliases_file = prompt("Where is the aliases file? Type a single dot for none.", $aliases_file); +my $imap_server = $::MULKONF->{imap_server} // "localhost"; +$imap_server = prompt("What is the IMAP server's address?", $imap_server); +my $imap_port = $::MULKONF->{imap_port} // 143; +$imap_port = int(prompt("What is the IMAP server's port?", $imap_port)); + +say "OK."; # Download jQuery. make_path("www/jquery"); @@ -67,16 +91,19 @@ close($specfile); say "Persona spec file saved to: browserid.json"; # Generate configuration file. -$MULKONF = { - configpath => $configpath, - pemfile => $pemfile +$::MULKONF = { + configpath => $configpath, + pemfile => $pemfile, + aliases_file => $aliases_file, + imap_server => $imap_server, + imap_port => $imap_port }; open(my $conffd, ">", $conffile) or die "Cannot open $conffile for writing: $!"; print $conffd <<EOF; #! /usr/bin/env perl # NB. Do not edit this file directly. It is overwritten with each run of setup.pl. -@{[Data::Dumper->Dump([$MULKONF], ["MULKONF"])]} +@{[Data::Dumper->Dump([$::MULKONF], ["::MULKONF"])]} 1; EOF close $conffd; diff --git a/www/common.pl b/www/common.pl new file mode 100644 index 0000000..7590fba --- /dev/null +++ b/www/common.pl @@ -0,0 +1,24 @@ +#! /usr/bin/env perl +# Copyright 2012, Matthias Andreas Benkard <code@mail.matthias.benkard.de>. + +use common::sense; +#use Modern::Perl 2011; +use Modern::Perl; + +use Mail::ExpandAliases; + + +sub email_users($$) { + ($config, $email) = @_; + my $alias; + if ($email =~ /^(.*?)@/) { $alias = $1; } + my $aliases_file = $config->{aliases}; + if (not ($aliases_file eq ".")) { + my $aliases = Mail::ExpandAliases->new($aliases_file); + my $session_user = $session->param('user'); + my $email_users = $aliases->expand($alias) or die "User not found"; + return @$email_users; + } else { + return ($alias); + } +} diff --git a/www/logged_in_p.pl b/www/logged_in_p.pl index a79d790..61b06c5 100755 --- a/www/logged_in_p.pl +++ b/www/logged_in_p.pl @@ -13,10 +13,13 @@ use CGI; use CGI::Fast; use CGI::Session; -use Mail::ExpandAliases; +do "common.pl"; while (my $cgi = new CGI::Fast) { + local $::MULKONF = { }; + do "config.pl"; + print $cgi->header(-content_type => 'application/json; charset=UTF-8'); my $cookie = $cgi->cookie('mulkid_session'); @@ -31,15 +34,9 @@ while (my $cgi = new CGI::Fast) { exit(0); } - my $aliases = Mail::ExpandAliases->new("/etc/aliases"); my $email = $cgi->param('email') or die "No email address supplied"; my $session_user = $session->param('user'); - - my $alias; - if ($email =~ /^(.*?)@/) { $alias = $1; } - my $email_users = $aliases->expand($alias) or die "User not found"; - - if ($session_user ~~ @$email_users) { + if ($session_user ~~ email_users($::MULKONF, $email)) { say encode_json({logged_in_p => 1}); } else { say encode_json({logged_in_p => 0}); diff --git a/www/login.pl b/www/login.pl index 630d5df..9f6831d 100755 --- a/www/login.pl +++ b/www/login.pl @@ -5,8 +5,6 @@ use common::sense; #use Modern::Perl 2011; use Modern::Perl; -use Mail::ExpandAliases; - use JSON; use CGI; @@ -16,14 +14,16 @@ use CGI::Session; use Mail::IMAPTalk ; #use IO::Socket::SSL; +do "common.pl"; -sub check_password($$) { - my ($user, $password) = @_; +sub check_password($$$) { + my ($config, $user, $password) = @_; #my $socket = IO::Socket::SSL->new('imap.googlemail.com:imaps'); my $imap = Mail::IMAPTalk->new( # Socket => $socket, - Server => 'localhost', + Server => $config->{imap_server}, + Port => $config->{imap_port}, Username => $user, Password => $password, Uid => 1 @@ -38,6 +38,9 @@ sub check_password($$) { while (my $cgi = new CGI::Fast) { + local $::MULKONF = { }; + do "config.pl"; + my $cookie = $cgi->cookie('mulkid_session'); my $session; if ($cookie) { @@ -56,18 +59,12 @@ while (my $cgi = new CGI::Fast) { -cookie => $cookie); } - my $aliases = Mail::ExpandAliases->new("/etc/aliases"); - my $email = $cgi->param('email') or die "No email address provided"; my $password = $cgi->param('password') or die "Empty password"; - my $alias; - if ($email =~ /^(.*?)@/) { $alias = $1; } - my $users = $aliases->expand($alias); - - for my $user (@$users) { + for my $user (email_users($::MULKONF, $email)) { #say STDERR "Trying user: $user"; - if (check_password($user, $password)) { + if (check_password($::MULKONF, $user, $password)) { $session->param('user', $user); say encode_json({user => $user}); exit 0; diff --git a/www/sign.pl b/www/sign.pl index 85f75b3..d936303 100755 --- a/www/sign.pl +++ b/www/sign.pl @@ -15,12 +15,12 @@ use CGI; use CGI::Fast; use CGI::Session; -use Mail::ExpandAliases; - use MIME::Base64 qw(encode_base64 decode_base64); use Time::HiRes qw(time); +do "common.pl"; + sub decode_base64_url($) { # From: https://github.com/ptarjan/base64url/blob/master/perl.pl @@ -39,14 +39,14 @@ sub encode_base64_url($) { } -sub sign($$$$) { +sub sign($$$$$) { # NB. Treating the jwcrypto code as the spec here. - my ($key, $client_pubkey, $email, $duration) = @_; + my ($key, $client_pubkey, $email, $duration, $domain) = @_; my $issued_at = int(1000*time); my $cert = { - iss => "mulk.eu", + iss => $domain, exp => $issued_at + 1000*$duration, iat => $issued_at, "public-key" => $client_pubkey, @@ -65,31 +65,28 @@ sub sign($$$$) { } -our $MULKONF; -do "config.pl"; - while (my $cgi = new CGI::Fast) { + local $::MULKONF = { }; + do "config.pl"; + my $cookie = $cgi->cookie('mulkid_session') or die "No session cookie"; my $session = new CGI::Session("driver:File", $cookie, {Directory=>"/tmp"}) or die "Invalid session cookie"; print $cgi->header(-content_type => 'application/json; charset=UTF-8'); - my $key = Crypt::OpenSSL::RSA->new_private_key(scalar read_file($MULKONF->{pemfile})); + my $key = Crypt::OpenSSL::RSA->new_private_key(scalar read_file($::MULKONF->{pemfile})); $key->use_pkcs1_padding(); $key->use_sha256_hash(); - my $aliases = Mail::ExpandAliases->new("/etc/aliases"); my $user_pubkey = $cgi->param('pubkey') or die "Nothing to sign"; my $duration = $cgi->param('duration') || 24*3600; my $email = $cgi->param('email') or die "No email address supplied"; my $session_user = $session->param('user'); - my $alias; my $domain; - if ($email =~ /^(.*?)@(.*)/) { $alias = $1; $domain = $2; } - my $email_users = $aliases->expand($alias) or die "User not found"; + if ($email =~ /^(.*?)@(.*)/) { $domain = $2; } die "User is not authorized to use this email address" - unless ($session_user ~~ @$email_users); + unless ($session_user ~~ email_users($::MULKONF, $email)); my $sig = sign $key, decode_json($user_pubkey), $email, $duration, $domain; say encode_json({signature => $sig}); |