#!/usr/bin/env perl # Copyright (c) 2010 Freie Universitaet Berlin. # # Permission to use, copy, modify, and/or distribute this software for any # purpose with or without fee is hereby granted, provided that the above # copyright notice and this permission notice appear in all copies. # # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # Written by Holger Weiss . # As there is no way to check whether a user is known to RADIUS without also # providing the correct password, we do our own user management. When # romeo@jabber.example.com registers, we create an empty file named # USER_DB_DIR/jabber.example.com/ro/romeo. When he unregisters, we delete # the file. So, we can check for the existence of this file in order to # answer the question whether romeo@jabber.example.com is a valid account. use strict; use warnings; use Authen::Radius; use File::Basename; use Getopt::Long; use Pod::Usage; use Sys::Syslog; use constant RADIUS_USER_AT_DOMAIN => 0; # romeo or romeo@jabber.example.com? use constant USER_DB_DIR => '/var/lib/ejabberd/users'; use constant SYSLOG_FACILITY => 'daemon'; my @radiusserver = ( { hostname => 'radius.example.com', port => 1812, secret => 'arcane', timeout => 3 } # Additional RADIUS servers can be specified here. ); my (@radiussocket, $radiusdown, $user, $password, $debug, $help, $man); sub report($$@); sub radiusinit(); sub radiuscheckpw($$$); sub userfilename($$); sub makedir($); sub adduser($$); sub deluser($$); sub isuser($$); sub permit($$$); sub deny($$$); sub report($$@) { my ($level, $format, @args) = @_; syslog($level, "[%s] $format", uc($level), @args); if ($debug) { $format =~ s/%m/$!/; syswrite(STDERR, sprintf("[%s] $format\n", uc($level), @args)); } } sub radiusinit() { for my $i (0 .. $#radiusserver) { my $radius = new Authen::Radius( Host => $radiusserver[$i]{hostname} . ':' . $radiusserver[$i]{port}, Secret => $radiusserver[$i]{secret}, TimeOut => $radiusserver[$i]{timeout}, Debug => $debug ); if ((defined $radius) and ($radius->get_error eq 'ENONE')) { push(@radiussocket, $radius); } else { report('warning', 'Initialization of %s:%u failed: %s', $radiusserver[$i]{hostname}, $radiusserver[$i]{port}, defined($radius) ? $radius->strerror : 'Unknown error'); } } return $#radiussocket + 1; } sub radiuscheckpw($$$) { my ($user, $domain, $password) = @_; my $radiususer = RADIUS_USER_AT_DOMAIN ? "$user\@$domain" : $user; for my $i (0 .. $#radiussocket) { my $answer = $radiussocket[$i]->check_pwd($radiususer, $password); return $answer if $radiussocket[$i]->get_error eq 'ENONE'; } report('err', 'Querying RADIUS failed for <%s@%s>.', $user, $domain); return 0; } sub userfilename($$) { my ($user, $domain) = @_; # E.g.: /var/lib/ejabberd/users/jabber.example.com/ro/romeo return sprintf('%s/%s/%s/%s', USER_DB_DIR, $domain, substr($user, 0, 2), $user); } sub makedir($) { my $dir = shift; unless (-d $dir) { my $parent = dirname($dir); if (not -d $parent) { makedir($parent) or return 0; } if (not mkdir($dir)) { report('err', 'Cannot create directory %s: %m', $dir); return 0; } } return 1; } sub adduser($$) { my ($user, $domain) = @_; my $filename = userfilename($user, $domain); my $fh; makedir(dirname($filename)) or return 0; if (not (open($fh, '>', $filename) and close($fh))) { report('err', 'Cannot create %s: %m', $filename); return 0; } return 1; } sub deluser($$) { my ($user, $domain) = @_; my $filename = userfilename($user, $domain); if (unlink($filename) != 1) { report('err', 'Cannot remove %s: %m', $filename); return 0; } rmdir(dirname($filename)); return 1; } sub isuser($$) { my ($user, $domain) = @_; return -e userfilename($user, $domain); } sub permit($$$) { my ($user, $domain, $operation) = @_; syswrite(STDOUT, pack('nn', 2, 1)); report('info', '%s OK for <%s@%s>.', $operation, $user, $domain); } sub deny($$$) { my ($user, $domain, $operation) = @_; syswrite(STDOUT, pack('nn', 2, 0)); report('info', '%s FAILED for <%s@%s>.', $operation, $user, $domain); } GetOptions( 'debug|d' => \$debug, 'help|h' => \$help, 'man|m' => \$man ) or pod2usage(-verbose => 1, -exitval => 2); pod2usage(-verbose => 1, -exitval => 0) if $help; pod2usage(-verbose => 2, -exitval => 0) if $man; openlog(basename($0), 'pid', SYSLOG_FACILITY); $SIG{__WARN__} = sub { report('crit', 'Caught warning: %s', $_[0] ? $_[0] : '(unknown)'); closelog(); exit(1); }; $SIG{__DIE__} = sub { report('crit', 'Caught exception: %s', $_[0] ? $_[0] : '(unknown)'); closelog(); exit(1); }; if (not radiusinit) { report('err', 'Initialization failed for all RADIUS servers.'); $radiusdown = 1; }; report('info', 'Waiting for requests from ejabberd.'); while (1) { my $buf; if (sysread(STDIN, $buf, 2) != 2) { report('info', 'The ejabberd port has been closed, exiting.'); closelog(); exit(0); } my $len = unpack('n', $buf); if (sysread(STDIN, $buf, $len) != $len) { report('crit', 'Reading %u bytes from ejabberd failed, exiting.', $len); closelog(); exit(1); } my ($op, $user, $domain, $password) = split(/:/, $buf, 4); if (not defined($domain) or (not defined($password) and $op =~ /^(?:auth|setpass|tryregister|removeuser3)$/)) { report('crit', 'Cannot parse ejabberd request, exiting.'); closelog(); exit(1); } if (length($user) < 2) { deny($user, $domain, "Username too short: $op"); } elsif ($radiusdown and $op =~ /^(?:auth|setpass|tryregister|removeuser3)$/) { deny($user, $domain, "RADIUS unavailable: $op"); } elsif ($op eq 'isuser') { if (isuser($user, $domain)) { permit($user, $domain, 'is-user-check'); } else { deny($user, $domain, 'is-user-check'); } } elsif ($op eq 'auth') { if (isuser($user, $domain) and radiuscheckpw($user, $domain, $password)) { permit($user, $domain, 'authentication'); } else { deny($user, $domain, 'authentication'); } } elsif ($op eq 'tryregister') { if (radiuscheckpw($user, $domain, $password) and adduser($user, $domain)) { permit($user, $domain, 'registration'); } else { deny($user, $domain, 'registration'); } } elsif ($op eq 'removeuser3') { if (radiuscheckpw($user, $domain, $password) and deluser($user, $domain)) { permit($user, $domain, 'unregistration (with password)'); } else { deny($user, $domain, 'unregistration (with password)'); } } elsif ($op eq 'removeuser') { if (deluser($user, $domain)) { permit($user, $domain, 'unregistration (without password)'); } else { deny($user, $domain, 'unregistration (without password)'); } } else { # We don't support "setpass" (even though we could). deny($user, $domain, "unsupported operation \"$op\""); } } __END__ =head1 NAME check_radius_perl - RADIUS authentication for ejabberd =head1 SYNOPSIS B [B<-d>] B B<-h> B B<-m> =head1 DESCRIPTION B provides a RADIUS authentication and user registration backend for ejabberd via the interface specified in F. =head1 OPTIONS =over 8 =item B<-d>, B<--debug> Enable debug mode. =item B<-h>, B<--help> Print a brief help message and exit. =item B<-m>, B<--man> Print the manual page and exit. =back =head1 AUTHOR Holger WeiE Eholger@ZEDAT.FU-Berlin.DEE