[LON-CAPA-cvs] cvs: loncom / lond lonsql /lonnet/perl lonnet.pm
raeburn
lon-capa-cvs-allow@mail.lon-capa.org
Wed, 12 Sep 2007 20:29:16 -0000
This is a MIME encoded message
--raeburn1189628956
Content-Type: text/plain
raeburn Wed Sep 12 16:29:16 2007 EDT
Modified files:
/loncom lonsql lond
/loncom/lonnet/perl lonnet.pm
Log:
Namespacing of usernames.
lonnet.pm
- &get_instuser() can check the institutional directory for a username or an ID.
-returns hash of user information (lastname,firstname etc.)
- &inst_rulecheck() can check whether a username matches the formats of institutional username rules.
- &inst_userrules() can retrieve information about username rules defined for the domain.
&get_instuser uses lonsql as a conduit to localenroll::get_userinfo() - operating in mode 1.
&inst_rulecheck() and &inst_userrules() use lond directly as the conduit to localenroll::username_check() and localenroll::username_rules() respectively
lond
- &get_institutional_user_rules() is interface to localenroll::username_rules()
- &institutional_username_check() is interface to localenroll::username_check()
lonsql
- &get_inst_user() retrieves is interface to localenroll::get_userinfo()
--raeburn1189628956
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20070912162916.txt"
Index: loncom/lonsql
diff -u loncom/lonsql:1.88 loncom/lonsql:1.89
--- loncom/lonsql:1.88 Tue Sep 11 23:40:29 2007
+++ loncom/lonsql Wed Sep 12 16:29:13 2007
@@ -3,7 +3,7 @@
# The LearningOnline Network
# lonsql - LON TCP-MySQL-Server Daemon for handling database requests.
#
-# $Id: lonsql,v 1.88 2007/09/12 03:40:29 raeburn Exp $
+# $Id: lonsql,v 1.89 2007/09/12 20:29:13 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -456,6 +456,8 @@
$srchtype,$srchterm);
} elsif ($query eq 'instdirsearch') {
$result = &do_inst_dir_search($searchdomain,$arg1,$arg2,$arg3);
+ } elsif ($query eq 'getinstuser') {
+ $result = &get_inst_user($searchdomain,$arg1,$arg2);
} elsif ($query eq 'prepare activity log') {
my ($cid,$domain) = map {&unescape($_);} ($arg1,$arg2);
&logthis('preparing activity log tables for '.$cid);
@@ -594,6 +596,30 @@
return $response;
}
+sub get_inst_user {
+ my ($domain,$uname,$id) = @_;
+ $uname = &unescape($uname);
+ $id = &unescape($id);
+ my (%instusers,%instids,$result,$response);
+ eval {
+ local($SIG{__DIE__})='DEFAULT';
+ $result=&localenroll::get_userinfo($domain,$uname,$id,\%instusers,
+ \%instids);
+ };
+ if ($result eq 'ok') {
+ if (keys(%instusers) > 0) {
+ foreach my $key (keys(%instusers)) {
+ my $usrstr = &Apache::lonnet::freeze_escape($instusers{$key});
+ $response .= &escape(&escape($key).'='.$usrstr).'&';
+ }
+ }
+ $response=~s/\&$//;
+ } else {
+ $response = 'unavailable';
+ }
+ return $response;
+}
+
########################################################
########################################################
Index: loncom/lond
diff -u loncom/lond:1.380 loncom/lond:1.381
--- loncom/lond:1.380 Thu Aug 23 13:39:51 2007
+++ loncom/lond Wed Sep 12 16:29:13 2007
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.380 2007/08/23 17:39:51 albertel Exp $
+# $Id: lond,v 1.381 2007/09/12 20:29:13 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -59,7 +59,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.380 $'; #' stupid emacs
+my $VERSION='$Revision: 1.381 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -4483,6 +4483,70 @@
®ister_handler("autoinstcodedefaults",
\&get_institutional_defaults_handler,0,1,0);
+sub get_institutional_user_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::username_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."\n",$userinput);
+ } else {
+ &Reply($client,"error\n", $userinput);
+ }
+ } else {
+ &Failure($client,"unknown_cmd\n",$userinput);
+ }
+}
+®ister_handler("instuserrules",\&get_institutional_user_rules,0,1,0);
+
+
+sub institutional_username_check {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my %rulecheck;
+ my $outcome;
+ my ($udom,$uname,@rules) = split(/:/,$tail);
+ $udom = &unescape($udom);
+ $uname = &unescape($uname);
+ @rules = map {&unescape($_);} (@rules);
+ eval {
+ local($SIG{__DIE__})='DEFAULT';
+ $outcome = &localenroll::username_check($udom,$uname,\@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."\n",$userinput);
+ } else {
+ &Reply($client,"error\n", $userinput);
+ }
+ } else {
+ &Failure($client,"unknown_cmd\n",$userinput);
+ }
+}
+®ister_handler("instrulecheck",\&institutional_username_check,0,1,0);
+
# Get domain specific conditions for import of student photographs to a course
#
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.911 loncom/lonnet/perl/lonnet.pm:1.912
--- loncom/lonnet/perl/lonnet.pm:1.911 Tue Sep 11 23:40:35 2007
+++ loncom/lonnet/perl/lonnet.pm Wed Sep 12 16:29:16 2007
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.911 2007/09/12 03:40:35 raeburn Exp $
+# $Id: lonnet.pm,v 1.912 2007/09/12 20:29:16 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -950,6 +950,100 @@
return %results;
}
+sub get_instuser {
+ my ($udom,$uname,$id) = @_;
+ my $homeserver = &domain($udom,'primary');
+ my ($outcome,%results);
+ if ($homeserver ne '') {
+ my $queryid=&reply("querysend:getinstuser:".&escape($uname).':'.
+ &escape($id).':'.&escape($udom),$homeserver);
+ my $host=&hostname($homeserver);
+ if ($queryid !~/^\Q$host\E\_/) {
+ &logthis('get_instuser invalid queryid: '.$queryid.' for host: '.$homeserver.'in domain '.$udom);
+ return;
+ }
+ my $response = &get_query_reply($queryid);
+ my $maxtries = 5;
+ my $tries = 1;
+ while (($response=~/^timeout/) && ($tries < $maxtries)) {
+ $response = &get_query_reply($queryid);
+ $tries ++;
+ }
+ if (!&error($response) && $response ne 'refused') {
+ if ($response eq 'unavailable') {
+ $outcome = $response;
+ } else {
+ $outcome = 'ok';
+ my @matches = split(/\n/,$response);
+ foreach my $match (@matches) {
+ my ($key,$value) = split(/=/,$match);
+ $results{&unescape($key)} = &thaw_unescape($value);
+ }
+ }
+ }
+ }
+ my %userinfo;
+ if (ref($results{$uname}) eq 'HASH') {
+ %userinfo = %{$results{$uname}};
+ }
+ return ($outcome,%userinfo);
+}
+
+sub inst_rulecheck {
+ my ($udom,$uname,$rules) = @_;
+ my %returnhash;
+ if ($udom ne '') {
+ if (ref($rules) eq 'ARRAY') {
+ @{$rules} = map {&escape($_);} (@{$rules});
+ my $rulestr = join(':',@{$rules});
+ my $homeserver=&domain($udom,'primary');
+ if (($homeserver ne '') && ($homeserver ne 'no_host')) {
+ my $response=&unescape(&reply('instrulecheck:'.&escape($udom).':'.
+ &escape($uname).':'.$rulestr,
+ $homeserver));
+ if ($response ne 'refused') {
+ my @pairs=split(/\&/,$response);
+ foreach my $item (@pairs) {
+ my ($key,$value)=split(/=/,$item,2);
+ $key = &unescape($key);
+ next if ($key =~ /^error: 2 /);
+ $returnhash{$key}=&thaw_unescape($value);
+ }
+ }
+ }
+ }
+ }
+ return %returnhash;
+}
+
+sub inst_userrules {
+ my ($udom) = @_;
+ my (%ruleshash,@ruleorder);
+ if ($udom ne '') {
+ my $homeserver=&domain($udom,'primary');
+ if (($homeserver ne '') && ($homeserver ne 'no_host')) {
+ my $response=&reply('instuserrules:'.&escape($udom),
+ $homeserver);
+ if (($response ne 'refused') && ($response ne 'error') &&
+ ($response ne 'no_such_host')) {
+ my ($hashitems,$orderitems) = split(/:/,$response);
+ my @pairs=split(/\&/,$hashitems);
+ foreach my $item (@pairs) {
+ my ($key,$value)=split(/=/,$item,2);
+ $key = &unescape($key);
+ next if ($key =~ /^error: 2 /);
+ $ruleshash{$key}=&thaw_unescape($value);
+ }
+ my @esc_order = split(/\&/,$orderitems);
+ foreach my $item (@esc_order) {
+ push(@ruleorder,&unescape($item));
+ }
+ }
+ }
+ }
+ return (\%ruleshash,\@ruleorder);
+}
+
# --------------------------------------------------- Assign a key to a student
sub assign_access_key {
--raeburn1189628956--