[LON-CAPA-cvs] cvs: loncom / lond /enrollment localenroll.pm /interface loncommon.pm /lonnet/perl lonnet.pm
raeburn
lon-capa-cvs-allow@mail.lon-capa.org
Sun, 24 Feb 2008 22:59:21 -0000
This is a MIME encoded message
--raeburn1203893961
Content-Type: text/plain
raeburn Sun Feb 24 17:59:21 2008 EDT
Modified files:
/loncom lond
/loncom/interface loncommon.pm
/loncom/lonnet/perl lonnet.pm
/loncom/enrollment localenroll.pm
Log:
lond::validate_user() - optional fourth and fifth arguments added in lond 1.395, replaced with a single optional argument ($checkdefauth). If true, default auth type and args retrieved using lonnet::get_domain_defaults().
- Default authentication type and argument, and language in a domain can be retrieved from lonnet::get_domain_defaults().
- lonnet::inst_rulecheck() can check format rules for e-mail addresses proposed as usernames for self-enrollment
- lonnet::inst_userrules() can retrieve rule definitions for e-mail addresses used as usernames
- loncommon::get_auth_defaults() eliminated. lonnet::get_domain_defaults() used instead
- loncommon::preferred_languages() streamlined.
- localenroll::selfenroll_rules() and localenroll::selfenroll_check() added to define rules for e-mail addresses which may not be used as usernames, and to check a proposed self-enrollment username (i.e., e-mail address) against the rules in force.
--raeburn1203893961
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20080224175921.txt"
Index: loncom/lond
diff -u loncom/lond:1.395 loncom/lond:1.396
--- loncom/lond:1.395 Thu Feb 21 11:04:19 2008
+++ loncom/lond Sun Feb 24 17:59:06 2008
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.395 2008/02/21 16:04:19 raeburn Exp $
+# $Id: lond,v 1.396 2008/02/24 22:59:06 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -59,7 +59,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.395 $'; #' stupid emacs
+my $VERSION='$Revision: 1.396 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -1514,16 +1514,15 @@
# udom - User's domain.
# uname - Username.
# upass - User's password.
- # defauthtype - Default authentication types for the domain
- # defautharg - Default authentication arg for the domain
+ # checkdefauth - Pass to validate_user() to try authentication
+ # with default auth type(s) if no user account.
- my ($udom,$uname,$upass,$defauthtype,$defautharg)=split(/:/,$tail);
+ my ($udom, $uname, $upass, $checkdefauth)=split(/:/,$tail);
&Debug(" Authenticate domain = $udom, user = $uname, password = $upass");
chomp($upass);
$upass=&unescape($upass);
- my $pwdcorrect = &validate_user($udom,$uname,$upass,$defauthtype,
- $defautharg);
+ my $pwdcorrect = &validate_user($udom,$uname,$upass,$checkdefauth);
if($pwdcorrect) {
&Reply( $client, "authorized\n", $userinput);
#
@@ -4704,6 +4703,40 @@
}
®ister_handler("instidrules",\&get_institutional_id_rules,0,1,0);
+sub get_institutional_selfenroll_rules {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my $dom = &unescape($tail);
+ my (%rules_hash,@rules_order);
+ my $outcome;
+ eval {
+ local($SIG{__DIE__})='DEFAULT';
+ $outcome = &localenroll::selfenroll_rules($dom,\%rules_hash,\@rules_order);
+ };
+ if (!$@) {
+ if ($outcome eq 'ok') {
+ my $result;
+ foreach my $key (keys(%rules_hash)) {
+ $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&';
+ }
+ $result =~ s/\&$//;
+ $result .= ':';
+ if (@rules_order > 0) {
+ foreach my $item (@rules_order) {
+ $result .= &escape($item).'&';
+ }
+ }
+ $result =~ s/\&$//;
+ &Reply($client,\$result,$userinput);
+ } else {
+ &Reply($client,"error\n", $userinput);
+ }
+ } else {
+ &Failure($client,"unknown_cmd\n",$userinput);
+ }
+}
+®ister_handler("instemailrules",\&get_institutional_selfenroll_rules,0,1,0);
+
sub institutional_username_check {
my ($cmd, $tail, $client) = @_;
@@ -4763,6 +4796,35 @@
}
®ister_handler("instidrulecheck",\&institutional_id_check,0,1,0);
+sub institutional_selfenroll_check {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my %rulecheck;
+ my $outcome;
+ my ($udom,$email,@rules) = split(/:/,$tail);
+ $udom = &unescape($udom);
+ $email = &unescape($email);
+ @rules = map {&unescape($_);} (@rules);
+ eval {
+ local($SIG{__DIE__})='DEFAULT';
+ $outcome = &localenroll::selfenroll_check($udom,$email,\@rules,\%rulecheck);
+ };
+ if (!$@) {
+ if ($outcome eq 'ok') {
+ my $result='';
+ foreach my $key (keys(%rulecheck)) {
+ $result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&';
+ }
+ &Reply($client,\$result,$userinput);
+ } else {
+ &Reply($client,"error\n", $userinput);
+ }
+ } else {
+ &Failure($client,"unknown_cmd\n",$userinput);
+ }
+}
+®ister_handler("instselfenrollcheck",\&institutional_selfenroll_check,0,1,0);
+
# Get domain specific conditions for import of student photographs to a course
#
# Retrieves information from photo_permission subroutine in localenroll.
@@ -5973,7 +6035,7 @@
# 0 - The domain,user,password triplet is not a valid user.
#
sub validate_user {
- my ($domain, $user, $password, $defauthtype, $defautharg) = @_;
+ my ($domain, $user, $password, $checkdefauth) = @_;
# Why negative ~pi you may well ask? Well this function is about
# authentication, and therefore very important to get right.
@@ -5997,13 +6059,17 @@
my $null = pack("C",0); # Used by kerberos auth types.
if ($howpwd eq 'nouser') {
- if ($defauthtype eq 'localauth') {
- $howpwd = $defauthtype;
- $contentpwd = $defautharg;
- } elsif ((($defauthtype eq 'krb4') || ($defauthtype eq 'krb5')) &&
- ($defautharg ne '')) {
- $howpwd = $defauthtype;
- $contentpwd = $defautharg;
+ if ($checkdefauth) {
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
+ if ($domdefaults{'auth_def'} eq 'localauth') {
+ $howpwd = $domdefaults{'auth_def'};
+ $contentpwd = $domdefaults{'auth_arg_def'};
+ } elsif ((($domdefaults{'auth_def'} eq 'krb4') ||
+ ($domdefaults{'auth_def'} eq 'krb5')) &&
+ ($domdefaults{'auth_arg_def'} ne '')) {
+ $howpwd = $domdefaults{'auth_def'};
+ $contentpwd = $domdefaults{'auth_arg_def'};
+ }
}
}
if ($howpwd ne 'nouser') {
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.640 loncom/interface/loncommon.pm:1.641
--- loncom/interface/loncommon.pm:1.640 Wed Feb 13 07:41:11 2008
+++ loncom/interface/loncommon.pm Sun Feb 24 17:59:13 2008
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.640 2008/02/13 12:41:11 bisitz Exp $
+# $Id: loncommon.pm,v 1.641 2008/02/24 22:59:13 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2242,42 +2242,6 @@
}
###############################################################
-## Get Authentication Defaults for Domain ##
-###############################################################
-
-=pod
-
-=head1 Domains and Authentication
-
-Returns default authentication type and an associated argument as
-listed in file 'domain.tab'.
-
-=over 4
-
-=item * get_auth_defaults
-
-get_auth_defaults($target_domain) returns the default authentication
-type and an associated argument (initial password or a kerberos domain).
-These values are stored in lonTabs/domain.tab
-
-($def_auth, $def_arg) = &get_auth_defaults($target_domain);
-
-If target_domain is not found in domain.tab, returns nothing ('').
-
-=cut
-
-#-------------------------------------------
-sub get_auth_defaults {
- my $domain=shift;
- return (&Apache::lonnet::domain($domain,'auth_def'),
- &Apache::lonnet::domain($domain,'auth_arg_def'));
-
-}
-###############################################################
-## End Get Authentication Defaults for Domain ##
-###############################################################
-
-###############################################################
## Get Kerberos Defaults for Domain ##
###############################################################
##
@@ -2292,8 +2256,8 @@
=item * get_kerberos_defaults
get_kerberos_defaults($target_domain) returns the default kerberos
-version and domain. If not found in domain.tabs, it defaults to
-version 4 and the domain of the server.
+version and domain. If not found, it defaults to version 4 and the
+domain of the server.
($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
@@ -2302,9 +2266,12 @@
#-------------------------------------------
sub get_kerberos_defaults {
my $domain=shift;
- my ($krbdef,$krbdefdom) =
- &Apache::loncommon::get_auth_defaults($domain);
- unless ($krbdef =~/^krb/ && $krbdefdom) {
+ my ($krbdef,$krbdefdom);
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
+ if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
+ $krbdef = $domdefaults{'auth_def'};
+ $krbdefdom = $domdefaults{'auth_arg_def'};
+ } else {
$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
my $krbdefdom=$1;
$krbdefdom=~tr/a-z/A-Z/;
@@ -2883,21 +2850,15 @@
map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser));
push(@languages,@browser);
}
- if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) {
- @languages=(@languages,
- &Apache::lonnet::domain($env{'user.domain'},
- 'lang_def'));
- }
- if (&Apache::lonnet::domain($env{'request.role.domain'},'lang_def')) {
- @languages=(@languages,
- &Apache::lonnet::domain($env{'request.role.domain'},
- 'lang_def'));
- }
- if (&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
- 'lang_def')) {
- @languages=(@languages,
- &Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
- 'lang_def'));
+
+ foreach my $domtype ($env{'user.domain'},$env{'request.role.domain'},
+ $Apache::lonnet::perlvar{'lonDefDomain'}) {
+ if ($domtype ne '') {
+ my %domdefs = &Apache::lonnet::get_domain_defaults($domtype);
+ if ($domdefs{'lang_def'} ne '') {
+ push(@languages,$domdefs{'lang_def'});
+ }
+ }
}
# turn "en-ca" into "en-ca,en"
my @genlanguages;
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.942 loncom/lonnet/perl/lonnet.pm:1.943
--- loncom/lonnet/perl/lonnet.pm:1.942 Thu Feb 21 05:04:35 2008
+++ loncom/lonnet/perl/lonnet.pm Sun Feb 24 17:59:17 2008
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.942 2008/02/21 10:04:35 foxr Exp $
+# $Id: lonnet.pm,v 1.943 2008/02/24 22:59:17 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1064,6 +1064,10 @@
$response=&unescape(&reply('instidrulecheck:'.&escape($udom).
':'.&escape($id).':'.$rulestr,
$homeserver));
+ } elsif ($item eq 'selfenroll') {
+ $response=&unescape(&reply('instselfenrollcheck:'.
+ &escape($udom).':'.&escape($uname).
+ ':'.$rulestr,$homeserver));
}
if ($response ne 'refused') {
my @pairs=split(/\&/,$response);
@@ -1090,6 +1094,9 @@
if ($check eq 'id') {
$response=&reply('instidrules:'.&escape($udom),
$homeserver);
+ } elsif ($check eq 'email') {
+ $response=&reply('instemailrules:'.&escape($udom),
+ $homeserver);
} else {
$response=&reply('instuserrules:'.&escape($udom),
$homeserver);
@@ -1115,6 +1122,35 @@
return (\%ruleshash,\@ruleorder);
}
+# ------------------------- Get Authentication and Language Defaults for Domain
+
+sub get_domain_defaults {
+ my ($domain) = @_;
+ my $cachetime = 60*60*24;
+ my ($defauthtype,$defautharg,$deflang);
+ my ($result,$cached)=&is_cached_new('domdefaults',$domain);
+ if (defined($cached)) {
+ if (ref($result) eq 'HASH') {
+ return %{$result};
+ }
+ }
+ my %domdefaults;
+ my %domconfig =
+ &Apache::lonnet::get_dom('configuration',['defaults'],$domain);
+ if (ref($domconfig{'defaults'}) eq 'HASH') {
+ $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
+ $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
+ $domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'};
+ } else {
+ $domdefaults{'lang_def'} = &domain($domain,'lang_def');
+ $domdefaults{'auth_def'} = &domain($domain,'auth_def');
+ $domdefaults{'auth_arg_def'} = &domain($domain,'auth_arg_def');
+ }
+ &Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults,
+ $cachetime);
+ return %domdefaults;
+}
+
# --------------------------------------------------- Assign a key to a student
sub assign_access_key {
@@ -9362,6 +9398,18 @@
domain level either on specified domain server ($uhome) or primary domain
server ($udom and $uhome are optional)
+=item *
+
+get_domain_defaults($target_domain) : returns hash with defaults for
+authentication and language in the domain. Keys are: auth_def, auth_arg_def,
+lang_def; corresponsing values are authentication type (internal, krb4, krb5,
+or localauth), initial password or a kerberos realm, language (e.g., en-us).
+Values are retrieved from cache (if current), or from domain's configuration.db
+(if available), or lastly from values in lonTabs/dns_domain,tab,
+or lonTabs/domain.tab.
+
+%domdefaults = &get_auth_defaults($target_domain);
+
=back
=head2 Network Status Functions
Index: loncom/enrollment/localenroll.pm
diff -u loncom/enrollment/localenroll.pm:1.29 loncom/enrollment/localenroll.pm:1.30
--- loncom/enrollment/localenroll.pm:1.29 Thu Jan 3 18:28:33 2008
+++ loncom/enrollment/localenroll.pm Sun Feb 24 17:59:20 2008
@@ -1,6 +1,6 @@
# functions to glue school database system into Lon-CAPA for
# automated enrollment
-# $Id: localenroll.pm,v 1.29 2008/01/03 23:28:33 raeburn Exp $
+# $Id: localenroll.pm,v 1.30 2008/02/24 22:59:20 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -648,7 +648,6 @@
#
# (c) $rulesorder - reference to array containing rule names
# in order to be displayed
-
#
# returns 'ok' if no processing error.
#
@@ -661,6 +660,33 @@
}
###############################
+# sub selfenroll_rules
+#
+# Incoming data: three arguments
+# (a) $dom - domain
+# (b) $ruleshash - reference to hash containing rules
+# (a hash of a hash)
+# keys of top level hash are short names
+# (e.g., netid)
+# for each key, value is a hash
+# desc => long name for rule
+# rule => description of rule
+#
+# (c) $rulesorder - reference to array containing rule names
+# in order to be displayed
+#
+# returns 'ok' if no processing error.
+#
+###############################
+
+
+sub selfenroll_rules {
+ my ($dom,$ruleshash,$rulesorder) = @_;
+ my $outcome;
+ return $outcome;
+}
+
+###############################
# sub username_check
#
# Incoming data: four arguments
@@ -705,6 +731,28 @@
}
###############################
+# sub selfenroll_check
+#
+# Incoming data: four arguments
+# (a) $dom - domain (scalar)
+# (b) $selfenrollname - e-mail proposed as username (compare against rules - scalar)
+# (c) $to_check (reference to array of rule names to check)
+# (d) $resultshash (reference to hash of results)
+# hash of results for rule checked
+# - keys are rule names
+# - values are: 1 or 0 (for matched or unmatched)
+#
+# returns 'ok' if no processing error.
+#
+###############################
+
+sub selfenroll_check {
+ my ($dom,$selfenrollname,$to_check,$resultshash) = @_;
+ my $outcome;
+ return $outcome;
+}
+
+###############################
# sub AUTOLOAD
#
# Incoming data: none
--raeburn1203893961--