[LON-CAPA-cvs] cvs: modules /gerd signon.pl

[www]

www		Mon Jul 22 14:38:15 2002 EDT

  Modified files:              
    /modules/gerd	signon.pl 
  Log:
  Still a long way to go - gets "con_lost" now.
  
  
Index: modules/gerd/signon.pl
diff -u modules/gerd/signon.pl:1.2 modules/gerd/signon.pl:1.3
--- modules/gerd/signon.pl:1.2	Mon Jul 22 12:56:29 2002
+++ modules/gerd/signon.pl	Mon Jul 22 14:38:15 2002
@@ -12,7 +12,13 @@
 my $demohome='worfl1';
 my %perlvar=();
 my %form=();
+my %democourses=();
 my $courses;
+my %hostname=();
+my %hostdom=();
+my %domaindescription=();
+my %libserv=();
+my %hostip=();
 
     my %formfields=('afirst' => 'First Name',
                     'blast'  => 'Last Name',
@@ -30,6 +36,48 @@
 use IO::File;
 use IO::Socket;
 
+
+# ------------------------------------------------------------- Declutters URLs
+
+sub declutter {
+    my $thisfn=shift;
+    $thisfn=~s/^$perlvar{'lonDocRoot'}//;
+    $thisfn=~s/^\///;
+    $thisfn=~s/^res\///;
+    $thisfn=~s/\?.+$//;
+    return $thisfn;
+}
+
+# -------------------------------------------------------- Escape Special Chars
+
+sub escape {
+    my $str=shift;
+    $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
+    return $str;
+}
+
+# ----------------------------------------------------- Un-Escape Special Chars
+
+sub unescape {
+    my $str=shift;
+    $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
+    return $str;
+}
+
+
+# ------------------------------------------------------------------- Log stuff
+
+sub logthis {
+
+    my $message=shift;
+    my $execdir=$perlvar{'lonDaemons'};
+    my $now=time;
+    my $local=localtime($now);
+    open(FH,">>$execdir/logs/demo.log");
+    print FH "$local ($$): $message\n";
+    close(FH);
+    return 1;
+}
 # -------------------------------------------------- Non-critical communication
 sub reply {
     my ($cmd,$server)=@_;
@@ -46,8 +94,37 @@
 }
 
 
+sub put {
+   my ($namespace,$storehash,$udomain,$uname)=@_;
+   my $uhome=&homeserver($uname,$udomain);
+   my $items='';
+   foreach (keys %$storehash) {
+       $items.=&escape($_).'='.&escape($$storehash{$_}).'&';
+   }
+   $items=~s/\&$//;
+   return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
+}
+
+
 # ------------- Modified routines from lonnet to make a new student in a course
 
+# ---------------------- Find the homebase for a user from domain's lib servers
+
+sub homeserver {
+    my ($uname,$udom)=@_;
+    my $index="$uname:$udom";
+    my $tryserver;
+    foreach $tryserver (keys %libserv) {
+	if ($hostdom{$tryserver} eq $udom) {
+           my $answer=reply("home:$udom:$uname",$tryserver);
+           if ($answer eq 'found') { 
+              return $tryserver; 
+           } 
+       }
+    }    
+    return 'no_host';
+}
+
 
 # ----------------------------------------------------------------- Assign Role
 
@@ -140,8 +217,16 @@
     return &assignrole($uname,$uurl,'st',$end,$start);
 }
 
-
-
+sub enroll {
+    my ($uname,$upass,$first,$last)=@_;
+    my $returnval='';
+    foreach (split(/\&/,$courses)) {
+	my ($cdom,$chome,$cid)=split(/\:/,$democourses{$_});
+        $returnval.=
+         &modifystudent($uname,$upass,$first,$last,$cid,$cdom,$chome)."<br>\n";
+    }
+    return $returnval;
+}
 # ------------------------------------------------------------- Make a password
 
 sub genpass {
@@ -203,6 +288,17 @@
 
 sub sendemail {
 }
+
+sub readdemo {
+    open(IN,$perlvar{'lonTabDir'}.'/democourses.tab') || 
+        die "Could not open demo course file from ".$perlvar{'lonTabDir'};
+    while (my $line=<IN>) {
+	chomp($line);
+        my ($name,$descr)=split(/\&/,$line);
+        $democourses{$name}=$descr;
+    }
+    close(IN);
+}
 # ================================================================ Main Program
 
 print "Content-type: text/html\n\n".
@@ -218,6 +314,27 @@
 delete $perlvar{'lonReceipt'};   # remove since sensitive and not needed
 delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
 
+&readdemo();
+
+# ------------------------------------------------------------- Read hosts file
+{
+    open(CONFIG,"$perlvar{'lonTabDir'}/hosts.tab");
+
+    while (my $configline=<CONFIG>) {
+       chomp($configline);
+       my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline);
+       $hostname{$id}=$name;
+       $hostdom{$id}=$domain;
+       $hostip{$id}=$ip;
+       if ($domdescr) {
+	   $domaindescription{$domain}=$domdescr;
+       }
+       if ($role eq 'library') { $libserv{$id}=$name; }
+    }
+    close(CONFIG);
+}
+
+
 # --------------------------------------------------------------- Get post vars
 
             my $buffer;
@@ -239,7 +356,7 @@
 $courses=$ENV{'QUERY_STRING'};
 $courses =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
 $courses =~ s/[^a-z\&]//g;
-
+unless ($courses) { $courses='default'; }
 # ------------------------------------------------------------ Check Form Input
 
 my $error=&checkform();
@@ -257,6 +374,7 @@
 #}
 }
 # ------------------------------------------------------------------------- End
+print &enroll('fred','flint','Fred','Flintstone');
     print("</body></html>\n");
 1;