#!/usr/bin/perl -w
use strict;
use Mail::IMAPClient;
use File::stat;
use Sys::Syslog;
use File::Basename;
my $NAME=basename $0;
my $debug = 0;
# Make sure the output is valid
print "Content-type: text/html\n\n";
print "<html>
<head>
<Title>Wireless authorization</Title>
</head>
<body>
";
# See if someone's trying to access the auth bits incorrectly
if ($ENV{'REQUEST_METHOD'} ne "POST") {
print "Sorry, this form is not for $ENV{'REQUEST_METHOD'} requests<br>\n";
} else {
(my $username, my $password, my $ip, my $mac) = parse_post();
# I made this is a call to a subroutine so if anyone wants a different auth method
# they can just change that one subroutine.
if (authenticate($username,$password)) {
# Create the file and insert it's MAC for the daemon to parse and run the
# proper iptables rules to allow this host through.
open(FILE,">/tmp/new_auth$ip") || my_bad("Couldn't open /tmp/new_auth$ip for auth daemon");
print FILE "$mac";
close(FILE);
print "Authorization complete... please wait for filter to take effect....<br>\n";
# Wait for auth daemon to write out file letting this script know it's ok to let user
# know it's rules have been run.
while (! -f "/tmp/auth_done$ip$mac") {
sleep 1;
}
# Do a quickie test to make sure the file is owned by the right user/group.. quasi
# security and way to keep user from spoofing. Does leave open possible DOS attacks
# by user.
my $info = stat("/tmp/auth_done$ip$mac");
my $file_gid = $info->gid;
my $file_uid = $info->uid;
my $apache_uid = 48;
my $apache_gid = 48;
if ( ( $file_uid != $apache_uid ) || ($file_gid != $apache_gid) ) {
finish_html("There was a problem with the authorization file, please contact Mike");
my_die("File /tmp/auth_done$ip$mac had wrong uid/gid: $file_uid / $file_gid, please investigate",1);
}
unlink("/tmp/auth_done$ip$mac");
finish_html("Filter rules in place, you now have access to the net<br>\n");
} else {
finish_html("Authorization failed, please go <a href=https://10.0.1.1/wireless_auth/>back</a> and try again<br>\n");
}
}
# sub that just saved me from printing out the final html tags more then once.
sub finish_html {
my $msg = shift;
print "
$msg
</body>
</html>
";
}
# Parse the POST info passed via webserver and set variables
# I used the Sys::Syslog bits here to log data if $debug at the head is set to 1
# to help troubleshoot some stuff.
sub parse_post {
my $pw = "";
my $un = "";
my $ip = "";
my $mac = "";
read(STDIN, my $buffer, $ENV{'CONTENT_LENGTH'});
my @args = split(/&/,$buffer);
while (my $line = pop @args) {
if ($debug) {
open(DEBUG,">>/tmp/debug.auth");
print DEBUG "before scrub: $line\n";
openlog("auth.cgi", "cons,pid", "user");
syslog("local1|info","info: post line: $line");
closelog();
}
$line = scrub_html($line);
if ($debug) {
print DEBUG "After scrub: $line\n\n";
close(DEBUG);
openlog("auth.cgi", "cons,pid", "user");
syslog("local1|info","info: post line after changes: $line");
closelog();
}
(my $arg, my $value) = split(/=/,$line);
if ($arg eq "user_pass") {
$pw = $value;
} elsif ($arg eq "user_name") {
$un = $value;
} elsif ($arg eq "rem_ip") {
$ip = $value;
} elsif ($arg eq "rem_mac") {
$mac = $value;
# never could find why the mac had two +'s added, but this strips them if they're there.
$mac =~ s/\+\+//g;
}
}
if ($debug) {
openlog("auth.cgi", "cons,pid", "user");
syslog("local1|info","info: parsed from post ip: $ip, mac: $mac, user: $un, pass $pw");
closelog();
}
return $un,$pw,$ip,$mac;
}
#Simple authentication subroutine. Currently just authenticates against a running imap server on localhost.
# I already have an imap server so I used that.
sub authenticate {
my $user_name = shift;
my $user_pass = shift;
my $imapConn = Mail::IMAPClient->new;
$imapConn->Port("143");
$imapConn->Server("localhost");
$imapConn->User($user_name);
$imapConn->Password($user_pass);
if ($debug) {
openlog("auth.cgi", "cons,pid", "user");
syslog("local1|info","info: About to auth with $user_name pw: $user_pass");
closelog();
}
if ($imapConn->connect() && $imapConn->login()) {
$imapConn->logout();
return 1;
} else {
return 0;
}
}
# Made my own die subroutine to make sure and syslog what went wrong before quitting so that admin can
# have at least some idea what happened.
sub my_die {
my $msg = shift;
my $fatal = shift;
if ($fatal) {
openlog($NAME, "cons,pid", "user");
syslog("local1|info","fatal: $msg");
closelog();
exit 1;
}
return 0;
}
# Special characters (which we all have at least one of in our password.. right?) are changed by web server
# when passed since it can't handle raw special characters. This routine changes them back.
sub scrub_html {
my $line = shift;
$line =~ s/%3A/:/g;
$line =~ s/%23/#/g;
$line =~ s/%40/@/g;
$line =~ s/%21/!/g;
$line =~ s/\s+//g;
$line =~ s/%24/\$/g;
$line =~ s/%25/%/g;
$line =~ s/%26/\&/g;
$line =~ s/%2A/\*/g;
$line =~ s/%2B/\+/g;
$line =~ s/%3D/=/g;
$line =~ s/%28/\(/g;
$line =~ s/%29/\)/g;
if ($line =~ /\+\+$/) {
$line =~ s/\+\+//g;
}
return $line;
}