#!/usr/bin/perl
# $Id: pwcheck_radius.pl,v 1.10 2005/12/18 03:31:46 jcs Exp $
# vim:ts=4
#
# pwcheck_radius
# a sasl pwcheck daemon to authenticate against a radius server
#
# Written by Joshua Stein <jcs@eng.dls.net>
# Copyright (c) 2004-2005 DLS Internet Services
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. The name of the author may not be used to endorse or promote products
#    derived from this software without specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#

use strict;
use IO::Socket;
use MD5;
use POSIX;
use Socket;
use Sys::Hostname;

# radius server info
my $radserver = "localhost";
my $radsecret = "secret";
my $radretries = 2;
my $radtimeout = 2;

# where our socket will live
# (for chrooted postfix, make /var/pwcheck a symlink to
# /var/spool/postfix/var/pwcheck, this way things outside the chroot can still
# access it as /var/pwcheck/pwcheck)
my $pwcheckpath = "/var/pwcheck/pwcheck";

# user (and its group) to drop privileges to
my $noprivuser = "_pwcheck";

# end of configuration

my $debug;
if ($ARGV[0] eq "-d") {
	$debug++;
}

# remove any existing socket
unlink($pwcheckpath);

# our socket will deliminate fields with \000
$/ = "\000";

# create the socket
my $listen = IO::Socket::UNIX->new(
	"Type" => SOCK_STREAM,
	"Local" => $pwcheckpath,
	"Listen" => 0
);
if (!$listen) {
	die "can't listen to " . $pwcheckpath . "\n";
}

# allow postfix to write to it
chmod(0777, $pwcheckpath);

# these are unlikely to change, don't bother looking them up every time
my $sockproto = getprotobyname("udp") or
	die "can't getprotobyname(udp): " . $!;
my $sockiaddr = gethostbyname($radserver) or
	die "can't gethostbyname(" . $radserver . "): " . $!;
my $sockport = getservbyname("radius", "udp") or
	die "can't getservbyname(radius, udp): " . $!;

# try to resolve our system's ip
my $ourhostname = inet_ntoa((gethostbyname(hostname))[4]);
if (!$ourhostname) {
	die "can't resolve my own hostname";
}
my @ourip = split(/\./, $ourhostname);

# resolve our uid
my @pw = getpwnam($noprivuser) or
	die "can't resolve uid of user " . $noprivuser . "\n";
endpwent();

# chroot to the $pwcheckpath
my @t = split(/\//, $pwcheckpath);
pop(@t);
my $pwcheckdir = join("/", @t);
chroot($pwcheckdir) or die "can't chroot to " . $pwcheckdir . ": " . $!;
chdir("/") or die "can't chdir to /: " . $!;

# drop privileges
POSIX::setgid($pw[3]) or die "can't setgid(" . $pw[3] . "): " . $!;
POSIX::setuid($pw[2]) or die "can't setuid(" . $pw[2] . "): " . $!;

# sit and listen
while (my $sock = $listen->accept()) {
	chop(my $username = $sock->getline);
	chop(my $password = $sock->getline);

	if ($debug) {
		print "username: " . $username . "\n";
		print "password: " . ($debug > 1 ? $password : "...") . "\n";
	}

	if (radauth($username, $password)) {
		if ($debug) {
			print "sending ok\n";
		}

		$sock->printflush("OK\000");
	} else {
		if ($debug) {
			print "sending incorrect password\n";
		}

		$sock->printflush("Incorrect password\000");
	}

	$sock->close;

	if ($debug) {
		print "-" x 40 . "\n";
	}
}

exit;

sub radauth {
	my ($username, $password) = @_;

	my $tusername = $username;
	my $tpassword = $password;

	# build a socket
	socket(RADIUS, PF_INET, SOCK_DGRAM, $sockproto) or
		die "no socket: " . $!;
	my $sin = sockaddr_in($sockport, $sockiaddr);

	# 16 bytes of randomness
	my $authenticator = pack("CCCCCCCCCCCCCCCC",
		int(1 + rand(255)), int(1 + rand(255)), int(1 + rand(255)),
		int(1 + rand(255)), int(1 + rand(255)), int(1 + rand(255)),
		int(1 + rand(255)), int(1 + rand(255)), int(1 + rand(255)),
		int(1 + rand(255)), int(1 + rand(255)), int(1 + rand(255)),
		int(1 + rand(255)), int(1 + rand(255)), int(1 + rand(255)),
		int(1 + rand(255))
	);

	# pad password to a multiple of 16 bytes
	if ((length($password) % 16) != 0) {
		for (my $x = 16; $x > (length($tpassword) % 16); $x--) {
			$tpassword .= "\0";
		}
	}

	# then cut it up into 16-byte pieces, hashing each one
	my $encpassword;
	for (my $x = 0; $x <= (int(length($tpassword) - 1) / 16); $x++) {
		my $piece = substr($tpassword, $x * 16, 16);

		if ($encpassword) {
			# instead of using the authenticator, we use 16 octets
			# from the first xor
			$encpassword .= emdeefive($piece, $radsecret,
				substr($encpassword, ($x - 1) * 16, 16));
		} else {
			$encpassword .= emdeefive($piece, $radsecret,
				$authenticator);
		}
	}

	# calculate the length of the packet
	my $slen = 4 + 16 + 6 + (2 + length($username)) +
		(2 + length($encpassword)) + 6 + 6;

	# create a unique request
	my $reqid = int(1 + rand(255));

	# assemble the packet
	my $payload = pack(
		"CCCC".						# code, ident, len
		"a*" .						# authenticator
		"CCCCCC" .					# service type
		"CCa*" .					# 1: username
		"CCa*" .					# 2: password
		"CCCCCC" .					# 4: nas ip
		"CCCCCC",					# 5: nas port

		1, $reqid, $slen / 256, $slen % 256,		# access-request
		$authenticator,					# authenticator
		6, 6, 0, 0, 0, 1,				# service-type
		1, 2 + length($username), $username,		# 1: username
		2, 2 + length($encpassword), $encpassword,	# 2: password
		4, 6, $ourip[0], $ourip[1], $ourip[2], $ourip[3], # 4: our IP
		5, 6, 0, 0, 0, 0);				# 5: nas port

	my $tries = 0;
	while (++$tries <= $radretries) {
		if ($debug) {
			print "sending radius request to " . $radserver
				. ", try " . $tries . "\n";
		}

		my $ret = eval {
			local $SIG{"ALRM"} = sub { die "timed out\n"; };
			alarm $radtimeout;

			send(RADIUS, $payload, 0, $sin);
			recv(RADIUS, my $retdata, 1024, 0);
			close(RADIUS);

			alarm 0;

			if (ord(substr($retdata, 1, 1)) ne $reqid) {
				print STDERR "got radius reply for a request "
					. "that wasn't ours ("
					. ord(substr($retdata, 1, 1))
					. " vs our " . $reqid . ")\n";

				die "invalid response\n";
			}

			# pull out the authenticator
			my $checkauth = substr($retdata, 4, 16);

			# encode the returned packet with our original
			# authenticator and secret
			my $checkver = MD5->hash(substr($retdata, 0, 4)
				. $authenticator . substr($retdata, 20,
				length($retdata) - 20) . $radsecret);

			if ($checkver ne $checkauth) {
				print STDERR "radius authentication packet "
					. "fails verification (" . $checkver
					. " vs our " . $checkauth . ")\n";

				die "failed verification\n";
			}

			if (ord(substr($retdata, 0, 1)) eq "2") {
				# access-accept
				if ($debug) {
					print "received access-accept\n";
				}

				return "OK\n";
			} else {
				if ($debug) {
					print "received access-reject\n";
				}

				return "NO\n";
			}
		};

		if ($ret eq "OK\n") {
			if ($debug) {
				print "auth ok, returning 1\n";
			}
			return 1;
		} elsif ($ret eq "NO\n") {
			if ($debug) {
				print "auth bad, returning 0\n";
			}
			return 0;
		} else {
			if ($ret eq "timed out\n") {
				print STDERR "radius request to " . $radserver
					. " timed out\n";
			} 

			# we will retry if we have any left
		}
	}

	# if we got here, we're out of retries
	return 0;
}

sub emdeefive {
	my ($password, $key, $random) = @_;
	my $output;

	my $keyrandom = $key . $random;
	my $checksum = unpack("H*", MD5->hash($keyrandom));

	for (my $x = 0; $x <= 15; $x++) {
		my ($m, $k, $p);

		if ((2 * $x) > length($checksum)) {
			$m = 0;
		} else {
			$m = hex(substr($checksum, (2 * $x), 2));
		}

		if ($x > length($keyrandom)) {
			$k = 0;
		} else {
			$k = ord(substr($keyrandom, $x, 1));
		}

		if ($x > length($password)) {
			$p = 0;
		} else {
			$p = ord(substr($password, $x, 1));
		}

		my $c = $m ^ $p;
		$output .= chr($c);
	}

	return $output;
}