[LON-CAPA-cvs] cvs: loncom / lond
foxr
lon-capa-cvs@mail.lon-capa.org
Wed, 04 Aug 2004 21:11:16 -0000
This is a MIME encoded message
--foxr1091653876
Content-Type: text/plain
foxr Wed Aug 4 17:11:16 2004 EDT
Modified files:
/loncom lond
Log:
- Added passwd as handler dispatched function.
- Put the : back in the end of the authtype response since some clients
actually expect it.. go figure.
--foxr1091653876
Content-Type: text/plain
Content-Disposition: attachment; filename="foxr-20040804171116.txt"
Index: loncom/lond
diff -u loncom/lond:1.221 loncom/lond:1.222
--- loncom/lond:1.221 Mon Aug 2 16:59:46 2004
+++ loncom/lond Wed Aug 4 17:11:16 2004
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.221 2004/08/02 20:59:46 albertel Exp $
+# $Id: lond,v 1.222 2004/08/04 21:11:16 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -52,12 +52,12 @@
use LONCAPA::lonssl;
use Fcntl qw(:flock);
-my $DEBUG = 0; # Non zero to enable debug log entries.
+my $DEBUG = 1; # Non zero to enable debug log entries.
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.221 $'; #' stupid emacs
+my $VERSION='$Revision: 1.222 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -1224,15 +1224,15 @@
my $userinput = "$cmd:$tail";
# Pull the domain and username out of the command tail.
- # and call GetAuthType to determine the authentication type.
+ # and call get_auth_type to determine the authentication type.
my ($udom,$uname)=split(/:/,$tail);
- my $result = &GetAuthType($udom, $uname);
+ my $result = &get_auth_type($udom, $uname);
if($result eq "nouser") {
&Failure( $replyfd, "unknown_user\n", $userinput);
} else {
#
- # We only want to pass the second field from GetAuthType
+ # We only want to pass the second field from get_auth_type
# for ^krb.. otherwise we'll be handing out the encrypted
# password for internals e.g.
#
@@ -1240,7 +1240,7 @@
if($type =~ /^krb/) {
$type = $result;
}
- &Reply( $replyfd, "$type\n", $userinput);
+ &Reply( $replyfd, "$type:\n", $userinput);
}
return 1;
@@ -1418,6 +1418,99 @@
register_handler("auth", \&authenticate_handler, 1, 1, 0);
+#
+# Change a user's password. Note that this function is complicated by
+# the fact that a user may be authenticated in more than one way:
+# At present, we are not able to change the password for all types of
+# authentication methods. Only for:
+# unix - unix password or shadow passoword style authentication.
+# local - Locally written authentication mechanism.
+# For now, kerb4 and kerb5 password changes are not supported and result
+# in an error.
+# FUTURE WORK:
+# Support kerberos passwd changes?
+# Parameters:
+# $cmd - The command that got us here.
+# $tail - Tail of the command (remaining parameters).
+# $client - File descriptor connected to client.
+# Returns
+# 0 - Requested to exit, caller should shut down.
+# 1 - Continue processing.
+# Implicit inputs:
+# The authentication systems describe above have their own forms of implicit
+# input into the authentication process that are described above.
+sub change_password_handler {
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = $cmd.":".$tail; # Reconstruct client's string.
+
+ #
+ # udom - user's domain.
+ # uname - Username.
+ # upass - Current password.
+ # npass - New password.
+
+ my ($udom,$uname,$upass,$npass)=split(/:/,$tail);
+
+ $upass=&unescape($upass);
+ $npass=&unescape($npass);
+ &Debug("Trying to change password for $uname");
+
+ # First require that the user can be authenticated with their
+ # old password:
+
+ my $validated = &validate_user($udom, $uname, $upass);
+ if($validated) {
+ my $realpasswd = &get_auth_type($udom, $uname); # Defined since authd.
+
+ my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
+ if ($howpwd eq 'internal') {
+ &Debug("internal auth");
+ my $salt=time;
+ $salt=substr($salt,6,2);
+ my $ncpass=crypt($npass,$salt);
+ if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) {
+ &logthis("Result of password change for "
+ ."$uname: pwchange_success");
+ &Reply($client, "ok\n", $userinput);
+ } else {
+ &logthis("Unable to open $uname passwd "
+ ."to change password");
+ &Failure( $client, "non_authorized\n",$userinput);
+ }
+ } elsif ($howpwd eq 'unix') {
+ # Unix means we have to access /etc/password
+ &Debug("auth is unix");
+ my $execdir=$perlvar{'lonDaemons'};
+ &Debug("Opening lcpasswd pipeline");
+ my $pf = IO::File->new("|$execdir/lcpasswd > "
+ ."$perlvar{'lonDaemons'}"
+ ."/logs/lcpasswd.log");
+ print $pf "$uname\n$npass\n$npass\n";
+ close $pf;
+ my $err = $?;
+ my $result = ($err>0 ? 'pwchange_failure' : 'ok');
+ &logthis("Result of password change for $uname: ".
+ &lcpasswdstrerror($?));
+ &Reply($client, "$result\n", $userinput);
+ } else {
+ # this just means that the current password mode is not
+ # one we know how to change (e.g the kerberos auth modes or
+ # locally written auth handler).
+ #
+ &Failure( $client, "auth_mode_error\n", $userinput);
+ }
+
+ }
+ else {
+ &Failure( $client, "non_authorized\n", $userinput);
+ }
+
+ return 1;
+}
+register_handler("passwd", \&change_password_handler, 1, 1, 0);
+
+
#---------------------------------------------------------------
#
# Getting, decoding and dispatching requests:
@@ -1532,91 +1625,9 @@
#------------------- Commands not yet in spearate handlers. --------------
-# ---------------------------------------------------------------------- passwd
- if ($userinput =~ /^passwd/) { # encoded and client
- if (($wasenc==1) && isClient) {
- my
- ($cmd,$udom,$uname,$upass,$npass)=split(/:/,$userinput);
- chomp($npass);
- $upass=&unescape($upass);
- $npass=&unescape($npass);
- &Debug("Trying to change password for $uname");
- my $proname=propath($udom,$uname);
- my $passfilename="$proname/passwd";
- if (-e $passfilename) {
- my $realpasswd;
- { my $pf = IO::File->new($passfilename);
- $realpasswd=<$pf>; }
- chomp($realpasswd);
- my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
- if ($howpwd eq 'internal') {
- &Debug("internal auth");
- if (crypt($upass,$contentpwd) eq $contentpwd) {
- my $salt=time;
- $salt=substr($salt,6,2);
- my $ncpass=crypt($npass,$salt);
- {
- my $pf;
- if ($pf = IO::File->new(">$passfilename")) {
- print $pf "internal:$ncpass\n";
- &logthis("Result of password change for $uname: pwchange_success");
- print $client "ok\n";
- } else {
- &logthis("Unable to open $uname passwd to change password");
- print $client "non_authorized\n";
- }
- }
-
- } else {
- print $client "non_authorized\n";
- }
- } elsif ($howpwd eq 'unix') {
- # Unix means we have to access /etc/password
- # one way or another.
- # First: Make sure the current password is
- # correct
- &Debug("auth is unix");
- $contentpwd=(getpwnam($uname))[1];
- my $pwdcorrect = "0";
- my $pwauth_path="/usr/local/sbin/pwauth";
- unless ($contentpwd eq 'x') {
- $pwdcorrect=
- (crypt($upass,$contentpwd) eq $contentpwd);
- } elsif (-e $pwauth_path) {
- open PWAUTH, "|$pwauth_path" or
- die "Cannot invoke authentication";
- print PWAUTH "$uname\n$upass\n";
- close PWAUTH;
- &Debug("exited pwauth with $? ($uname,$upass) ");
- $pwdcorrect=($? == 0);
- }
- if ($pwdcorrect) {
- my $execdir=$perlvar{'lonDaemons'};
- &Debug("Opening lcpasswd pipeline");
- my $pf = IO::File->new("|$execdir/lcpasswd > $perlvar{'lonDaemons'}/logs/lcpasswd.log");
- print $pf "$uname\n$npass\n$npass\n";
- close $pf;
- my $err = $?;
- my $result = ($err>0 ? 'pwchange_failure'
- : 'ok');
- &logthis("Result of password change for $uname: ".
- &lcpasswdstrerror($?));
- print $client "$result\n";
- } else {
- print $client "non_authorized\n";
- }
- } else {
- print $client "auth_mode_error\n";
- }
- } else {
- print $client "unknown_user\n";
- }
- } else {
- Reply($client, "refused\n", $userinput);
-
- }
+
# -------------------------------------------------------------------- makeuser
- } elsif ($userinput =~ /^makeuser/) { # encoded and client.
+ if ($userinput =~ /^makeuser/) { # encoded and client.
&Debug("Make user received");
my $oldumask=umask(0077);
if (($wasenc==1) && isClient) {
@@ -2025,7 +2036,7 @@
foreach my $pair (@pairs) {
my ($key,$value)=split(/=/,$pair);
&ManagePermissions($key, $udom, $uname,
- &GetAuthType( $udom,
+ &get_auth_type( $udom,
$uname));
$hash{$key}=$value;
}
@@ -3818,17 +3829,89 @@
system("$execdir/lchtmldir $userhome $user $authtype");
}
}
+
+
+#
+# Return the full path of a user password file, whether it exists or not.
+# Parameters:
+# domain - Domain in which the password file lives.
+# user - name of the user.
+# Returns:
+# Full passwd path:
+#
+sub password_path {
+ my ($domain, $user) = @_;
+
+
+ my $path = &propath($domain, $user);
+ $path .= "/passwd";
+
+ return $path;
+}
+
+# Password Filename
+# Returns the path to a passwd file given domain and user... only if
+# it exists.
+# Parameters:
+# domain - Domain in which to search.
+# user - username.
+# Returns:
+# - If the password file exists returns its path.
+# - If the password file does not exist, returns undefined.
+#
+sub password_filename {
+ my ($domain, $user) = @_;
+
+ Debug ("PasswordFilename called: dom = $domain user = $user");
+
+ my $path = &password_path($domain, $user);
+ Debug("PasswordFilename got path: $path");
+ if(-e $path) {
+ return $path;
+ } else {
+ return undef;
+ }
+}
+
+#
+# Rewrite the contents of the user's passwd file.
+# Parameters:
+# domain - domain of the user.
+# name - User's name.
+# contents - New contents of the file.
+# Returns:
+# 0 - Failed.
+# 1 - Success.
+#
+sub rewrite_password_file {
+ my ($domain, $user, $contents) = @_;
+
+ my $file = &password_filename($domain, $user);
+ if (defined $file) {
+ my $pf = IO::File->new(">$file");
+ if($pf) {
+ print $pf "$contents\n";
+ return 1;
+ } else {
+ return 0;
+ }
+ } else {
+ return 0;
+ }
+
+}
+
#
-# GetAuthType - Determines the authorization type of a user in a domain.
+# get_auth_type - Determines the authorization type of a user in a domain.
# Returns the authorization type or nouser if there is no such user.
#
-sub GetAuthType
+sub get_auth_type
{
my ($domain, $user) = @_;
- Debug("GetAuthType( $domain, $user ) \n");
+ Debug("get_auth_type( $domain, $user ) \n");
my $proname = &propath($domain, $user);
my $passwdfile = "$proname/passwd";
if( -e $passwdfile ) {
@@ -3885,7 +3968,7 @@
# the user has been assigned. If the authentication type is
# "nouser", the user does not exist so we will return 0.
- my $contents = &GetAuthType($domain, $user);
+ my $contents = &get_auth_type($domain, $user);
my ($howpwd, $contentpwd) = split(/:/, $contents);
my $null = pack("C",0); # Used by kerberos auth types.
--foxr1091653876--