1# -*-perl-*- 2package Authen::PAM; 3 4use strict; 5#no strict "subs"; 6 7use Carp; 8use POSIX qw(EINVAL ENOSYS ECHO TCSANOW); 9use vars qw($VERSION @ISA %EXPORT_TAGS $AUTOLOAD); 10 11#use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD); 12 13require Exporter; 14require DynaLoader; 15 16@ISA = qw(Exporter DynaLoader); 17 18#@EXPORT = (); 19#@EXPORT_OK = (); 20 21%EXPORT_TAGS = ( 22 functions => [qw( 23 pam_start pam_end 24 pam_authenticate pam_setcred pam_acct_mgmt pam_chauthtok 25 pam_open_session pam_close_session 26 pam_set_item pam_get_item 27 pam_strerror 28 pam_getenv pam_putenv pam_getenvlist 29 pam_fail_delay 30 )], 31 constants => [qw( 32 PAM_SUCCESS PAM_OPEN_ERR PAM_SYMBOL_ERR PAM_SERVICE_ERR 33 PAM_SYSTEM_ERR PAM_BUF_ERR PAM_CONV_ERR PAM_PERM_DENIED 34 35 PAM_AUTH_ERR PAM_CRED_INSUFFICIENT PAM_AUTHINFO_UNAVAIL 36 PAM_USER_UNKNOWN PAM_MAXTRIES PAM_NEW_AUTHTOK_REQD 37 38 PAM_ACCT_EXPIRED PAM_SESSION_ERR PAM_CRED_UNAVAIL PAM_CRED_EXPIRED 39 PAM_CRED_ERR PAM_NO_MODULE_DATA PAM_AUTHTOK_ERR 40 PAM_AUTHTOK_RECOVER_ERR PAM_AUTHTOK_RECOVERY_ERR 41 PAM_AUTHTOK_LOCK_BUSY PAM_AUTHTOK_DISABLE_AGING PAM_TRY_AGAIN 42 PAM_IGNORE PAM_ABORT PAM_AUTHTOK_EXPIRED PAM_MODULE_UNKNOWN 43 PAM_BAD_ITEM PAM_CONV_AGAIN PAM_INCOMPLETE 44 45 PAM_SERVICE PAM_USER PAM_TTY PAM_RHOST PAM_CONV PAM_RUSER 46 PAM_USER_PROMPT PAM_FAIL_DELAY 47 48 PAM_SILENT PAM_DISALLOW_NULL_AUTHTOK 49 50 PAM_ESTABLISH_CRED PAM_DELETE_CRED PAM_REINITIALIZE_CRED 51 PAM_REFRESH_CRED PAM_CHANGE_EXPIRED_AUTHTOK 52 53 PAM_PROMPT_ECHO_OFF PAM_PROMPT_ECHO_ON PAM_ERROR_MSG 54 PAM_TEXT_INFO PAM_RADIO_TYPE PAM_BINARY_PROMPT 55 56 HAVE_PAM_FAIL_DELAY HAVE_PAM_ENV_FUNCTIONS 57 )], 58 old => [qw( 59 PAM_AUTHTOKEN_REQD PAM_CRED_ESTABLISH PAM_CRED_DELETE 60 PAM_CRED_REINITIALIZE PAM_CRED_REFRESH 61 )]); 62 63Exporter::export_tags('functions'); 64Exporter::export_tags('constants'); 65Exporter::export_ok_tags('old'); 66 67# These constants should be used only by modules and so 68# we will not export them. 69# PAM_AUTHTOK PAM_OLDAUTHTOK 70 71$VERSION = '@PACKAGE_VERSION@'; 72 73sub AUTOLOAD { 74 # This AUTOLOAD is used to 'autoload' constants from the constant() 75 # XS function. If a constant is not found then control is passed 76 # to the AUTOLOAD in AutoLoader. 77 78 my $constname; 79 ($constname = $AUTOLOAD) =~ s/.*:://; 80 my $val = constant($constname, @_ ? $_[0] : 0); 81 if ($! == 0) { 82 eval "sub $AUTOLOAD { $val }"; 83 goto &$AUTOLOAD; 84 } elsif ($! == EINVAL) { 85 $AutoLoader::AUTOLOAD = $AUTOLOAD; 86 goto &AutoLoader::AUTOLOAD; 87 } elsif ($! == ENOSYS) { 88 croak "The symbol $constname is not supported by your PAM library"; 89 } else { 90 croak "Error $! in loading the symbol $constname in module Authen::PAM"; 91 } 92} 93 94@DL_LOAD_FLAGS@ 95 96bootstrap Authen::PAM $VERSION; 97 98# Preloaded methods go here. 99 100sub pam_getenvlist ($) { 101 my @env = _pam_getenvlist($_[0]); 102 my %env; 103 for (@env) { 104 my ($name, $value) = /(.*)=(.*)/; 105 $env{$name} = $value; 106 } 107 return %env; 108} 109 110# Support for Objects 111 112sub new { 113 my $this = shift; 114 my $class = ref($this) || $this; 115 my $pamh; 116 my $retval = pam_start (@_, $pamh); 117 return $retval if $retval != PAM_SUCCESS(); 118 bless $pamh, $class; 119 return $pamh; 120} 121 122sub DESTROY { 123 my $pamh = shift; 124 my $retval = pam_end($pamh, 0); 125} 126 127# Default conversation function 128 129sub pam_default_conv { 130 my @res; 131 local $\ = ""; 132 while ( @_ ) { 133 my $code = shift; 134 my $msg = shift; 135 my $ans = ""; 136 137 print $msg unless $code == PAM_ERROR_MSG(); 138 139 if ($code == PAM_PROMPT_ECHO_OFF() ) { 140 my $termios = POSIX::Termios->new; 141 $termios->getattr(1); 142 my $c_lflag = $termios->getlflag; 143 $termios->setlflag($c_lflag & ~ECHO); 144 $termios->setattr(1, TCSANOW) ; 145 146 chomp( $ans = <STDIN> ); print "\n"; 147 148 $termios->setlflag($c_lflag); 149 $termios->setattr(1, TCSANOW); 150 } 151 elsif ($code == PAM_PROMPT_ECHO_ON() ) { chomp( $ans = <STDIN> ); } 152 elsif ($code == PAM_ERROR_MSG() ) { print STDERR "$msg\n"; } 153 elsif ($code == PAM_TEXT_INFO() ) { print "\n"; } 154 155 push @res, (PAM_SUCCESS(),$ans); 156 } 157 push @res, PAM_SUCCESS(); 158 return @res; 159} 160 161sub pam_start { 162 return _pam_start(@_) if @_ == 4; 163 return _pam_start($_[0], $_[1], \&pam_default_conv, $_[2]) if @_ == 3; 164 return _pam_start($_[0], undef, \&pam_default_conv, $_[1]) if @_ == 2; 165 croak("Wrong number of arguments in pam_start function"); 166} 167 168# Autoload methods go after =cut, and are processed by the autosplit program. 169 1701; 171__END__ 172# Below is the stub of documentation for your module. You better edit it! 173 174=head1 NAME 175 176Authen::PAM - Perl interface to PAM library 177 178=head1 SYNOPSIS 179 180 use Authen::PAM; 181 182 $res = pam_start($service_name, $pamh); 183 $res = pam_start($service_name, $user, $pamh); 184 $res = pam_start($service_name, $user, \&my_conv_func, $pamh); 185 $res = pam_end($pamh, $pam_status); 186 187 $res = pam_authenticate($pamh, $flags); 188 $res = pam_setcred($pamh, $flags); 189 $res = pam_acct_mgmt($pamh, $flags); 190 $res = pam_open_session($pamh, $flags); 191 $res = pam_close_session($pamh, $flags); 192 $res = pam_chauthtok($pamh, $flags); 193 194 $error_str = pam_strerror($pamh, $errnum); 195 196 $res = pam_set_item($pamh, $item_type, $item); 197 $res = pam_get_item($pamh, $item_type, $item); 198 199 if (HAVE_PAM_ENV_FUNCTIONS()) { 200 $res = pam_putenv($pamh, $name_value); 201 $val = pam_getenv($pamh, $name); 202 %env = pam_getenvlist($pamh); 203 } 204 205 if (HAVE_PAM_FAIL_DELAY()) { 206 $res = pam_fail_delay($pamh, $musec_delay); 207 $res = pam_set_item($pamh, PAM_FAIL_DELAY(), \&my_fail_delay_func); 208 } 209 210=head1 DESCRIPTION 211 212The I<Authen::PAM> module provides a Perl interface to the I<PAM> 213library. The only difference with the standard PAM interface is that 214instead of passing a pam_conv struct which has an additional context 215parameter appdata_ptr, you must only give an address to a conversation 216function written in Perl (see below). 217 218If you want to pass a NULL pointer as a value of the $user in 219pam_start use undef or the two-argument version. Both in the two and 220the three-argument versions of pam_start a default conversation 221function is used (Authen::PAM::pam_default_conv). 222 223The $flags argument is optional for all functions which use it 224except for pam_setcred. The $pam_status argument is also optional for 225pam_end function. Both of these arguments will be set to 0 if not given. 226 227The names of some constants from the PAM library have changed over the 228time. You can use any of the known names for a given constant although 229it is advisable to use the latest one. 230 231When this module supports some of the additional features of the PAM 232library (e.g. pam_fail_delay) then the corresponding HAVE_PAM_XXX 233constant will have a value 1 otherwise it will return 0. 234 235For compatibility with older PAM libraries I have added the constant 236HAVE_PAM_ENV_FUNCTIONS which is true if your PAM library has the 237functions for handling environment variables (pam_putenv, pam_getenv, 238pam_getenvlist). 239 240 241=head2 Object Oriented Style 242 243If you prefer to use an object oriented style for accessing the PAM 244library here is the interface: 245 246 use Authen::PAM qw(:constants); 247 248 $pamh = new Authen::PAM($service_name); 249 $pamh = new Authen::PAM($service_name, $user); 250 $pamh = new Authen::PAM($service_name, $user, \&my_conv_func); 251 252 ref($pamh) || die "Error code $pamh during PAM init!"; 253 254 $res = $pamh->pam_authenticate($flags); 255 $res = $pamh->pam_setcred($flags); 256 $res = $pamh->pam_acct_mgmt($flags); 257 $res = $pamh->pam_open_session($flags); 258 $res = $pamh->pam_close_session($flags); 259 $res = $pamh->pam_chauthtok($flags); 260 261 $error_str = $pamh->pam_strerror($errnum); 262 263 $res = $pamh->pam_set_item($item_type, $item); 264 $res = $pamh->pam_get_item($item_type, $item); 265 266 $res = $pamh->pam_putenv($name_value); 267 $val = $pamh->pam_getenv($name); 268 %env = $pamh->pam_getenvlist; 269 270The constructor new will call the pam_start function and if successfull 271will return an object reference. Otherwise the $pamh will contain the 272error number returned by pam_start. 273The pam_end function will be called automatically when the object is no 274longer referenced. 275 276=head2 Examples 277 278Here is an example of using PAM for changing the password of the current 279user: 280 281 use Authen::PAM; 282 283 $login_name = getpwuid($<); 284 285 pam_start("passwd", $login_name, $pamh); 286 pam_chauthtok($pamh); 287 pam_end($pamh); 288 289 290or the same thing but using OO style: 291 292 $pamh = new Authen::PAM("passwd", $login_name); 293 $pamh->pam_chauthtok; 294 $pamh = 0; # Force perl to call the destructor for the $pamh 295 296=head2 Conversation function format 297 298When starting the PAM the user must supply a conversation function. 299It is used for interaction between the PAM modules and the user. The 300argument of the function is a list of pairs ($msg_type, $msg) and it 301must return a list with the same number of pairs ($resp_retcode, 302$resp) with replies to the input messages. For now the $resp_retcode 303is not used and must be always set to 0. In addition the user must 304append to the end of the resulting list the return code of the 305conversation function (usually PAM_SUCCESS). If you want to abort 306the conversation function for some reason then just return an error 307code, normally PAM_CONV_ERR. 308 309Here is a sample form of the PAM conversation function: 310 311 sub my_conv_func { 312 my @res; 313 while ( @_ ) { 314 my $msg_type = shift; 315 my $msg = shift; 316 317 print $msg; 318 319 # switch ($msg_type) { obtain value for $ans; } 320 321 push @res, (0,$ans); 322 } 323 push @res, PAM_SUCCESS(); 324 return @res; 325 } 326 327More examples can be found in the L<Authen::PAM:FAQ>. 328 329=head1 COMPATIBILITY 330 331The following constant names: PAM_AUTHTOKEN_REQD, PAM_CRED_ESTABLISH, 332PAM_CRED_DELETE, PAM_CRED_REINITIALIZE, PAM_CRED_REFRESH are used by 333some older version of the Linux-PAM library and are not exported by 334default. If you really want them, load the module with 335 336 use Authen::PAM qw(:DEFAULT :old); 337 338This module still does not support some of the new Linux-PAM 339functions such as pam_system_log. 340 341=head1 SEE ALSO 342 343PAM Application developer's Manual, 344L<Authen::PAM::FAQ> 345 346=head1 AUTHOR 347 348Nikolay Pelov <NIKIP at cpan.org> 349 350=head1 COPYRIGHT 351 352Copyright (c) 1998-2005 Nikolay Pelov. All rights reserved. This 353program is free software; you can redistribute it and/or modify it 354under the same terms as Perl itself. 355 356=cut 357