[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.76 and 1.92

version 1.76, 2002/03/28 04:27:42 version 1.92, 2002/08/22 21:37:35
Line 53 Line 53
 # 02/12 Gerd Kortemeyer  # 02/12 Gerd Kortemeyer
 # 02/19 Matthew Hall  # 02/19 Matthew Hall
 # 02/25 Gerd Kortemeyer  # 02/25 Gerd Kortemeyer
   # 05/11 Scott Harrison
 ###  ###
   
 # based on "Perl Cookbook" ISBN 1-56592-243-3  # based on "Perl Cookbook" ISBN 1-56592-243-3
Line 61 Line 62
 # HUPs  # HUPs
 # uses IDEA encryption  # uses IDEA encryption
   
   use lib '/home/httpd/lib/perl/';
   use LONCAPA::Configuration;
   
 use IO::Socket;  use IO::Socket;
 use IO::File;  use IO::File;
 use Apache::File;  use Apache::File;
Line 70  use Crypt::IDEA; Line 74  use Crypt::IDEA;
 use LWP::UserAgent();  use LWP::UserAgent();
 use GDBM_File;  use GDBM_File;
 use Authen::Krb4;  use Authen::Krb4;
   use Authen::Krb5;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use localauth;  use localauth;
   
   my $DEBUG = 0;       # Non zero to enable debug log entries.
   
 my $status='';  my $status='';
 my $lastlog='';  my $lastlog='';
   
Line 99  sub timeout { Line 106  sub timeout {
 $SIG{'QUIT'}=\&catchexception;  $SIG{'QUIT'}=\&catchexception;
 $SIG{__DIE__}=\&catchexception;  $SIG{__DIE__}=\&catchexception;
   
 # ------------------------------------ Read httpd access.conf and get variables  # ---------------------------------- Read loncapa_apache.conf and loncapa.conf
   &status("Read loncapa_apache.conf and loncapa.conf");
 open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";  my $perlvarref=LONCAPA::Configuration::read_conf('loncapa_apache.conf',
                                                    'loncapa.conf');
 while ($configline=<CONFIG>) {  my %perlvar=%{$perlvarref};
     if ($configline =~ /PerlSetVar/) {  undef $perlvarref;
  my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);  
         chomp($varvalue);  
         $perlvar{$varname}=$varvalue;  
     }  
 }  
 close(CONFIG);  
   
 # ----------------------------- Make sure this process is running from user=www  # ----------------------------- Make sure this process is running from user=www
 my $wwwid=getpwnam('www');  my $wwwid=getpwnam('www');
Line 235  sub logthis { Line 236  sub logthis {
     print $fh "$local ($$): $message\n";      print $fh "$local ($$): $message\n";
 }  }
   
   # ------------------------- Conditional log if $DEBUG true.
   sub Debug {
       my $message = shift;
       if($DEBUG) {
    &logthis($message);
       }
   }
 # ------------------------------------------------------------------ Log status  # ------------------------------------------------------------------ Log status
   
 sub logstatus {  sub logstatus {
Line 481  sub make_new_child { Line 489  sub make_new_child {
             or die "Can't unblock SIGINT for fork: $!\n";              or die "Can't unblock SIGINT for fork: $!\n";
   
         $tmpsnum=0;          $tmpsnum=0;
       #---------------------------------------------------- kerberos 5 initialization
           &Authen::Krb5::init_context();
           &Authen::Krb5::init_ets();
   
         # handle connections until we've reached $MAX_CLIENTS_PER_CHILD          # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
         for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {          for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
             &status('Idle, waiting for connection');              &status('Idle, waiting for connection');
Line 540  sub make_new_child { Line 551  sub make_new_child {
 # ------------------------------------------------------------ Process requests  # ------------------------------------------------------------ Process requests
               while (my $userinput=<$client>) {                while (my $userinput=<$client>) {
                 chomp($userinput);                  chomp($userinput);
    Debug("Request = $userinput\n");
                 &status('Processing '.$hostid{$clientip}.': '.$userinput);                  &status('Processing '.$hostid{$clientip}.': '.$userinput);
                 my $wasenc=0;                  my $wasenc=0;
                 alarm(120);                  alarm(120);
Line 595  sub make_new_child { Line 607  sub make_new_child {
    } elsif ($userinput =~ /^currentauth/) {     } elsif ($userinput =~ /^currentauth/) {
      if ($wasenc==1) {       if ($wasenc==1) {
                        my ($cmd,$udom,$uname)=split(/:/,$userinput);                         my ($cmd,$udom,$uname)=split(/:/,$userinput);
                        my $proname=propath($udom,$uname);         my $result = GetAuthType($udom, $uname);
                        my $passfilename="$proname/passwd";         if($result eq "nouser") {
                        if (-e $passfilename) {     print $client "unknown_user\n";
    my $pf = IO::File->new($passfilename);         }
    my $realpasswd=<$pf>;         else {
    chomp($realpasswd);     print $client "$result\n"
    my ($howpwd,$contentpwd)=split(/:/,$realpasswd);         }
    my $availablecontent='';  
    if ($howpwd eq 'krb4') {  
        $availablecontent=$contentpwd;  
    }  
    print $client "$howpwd:$availablecontent\n";  
        } else {  
                           print $client "unknown_user\n";  
                        }  
      } else {       } else {
        print $client "refused\n";         print $client "refused\n";
      }       }
Line 652  sub make_new_child { Line 656  sub make_new_child {
                                         $contentpwd,'krbtgt',$contentpwd,1,                                          $contentpwd,'krbtgt',$contentpwd,1,
      $upass) == 0);       $upass) == 0);
      } else { $pwdcorrect=0; }       } else { $pwdcorrect=0; }
                             } elsif ($howpwd eq 'krb5') {
         $null=pack("C",0);
         unless ($upass=~/$null/) {
     my $krbclient=&Authen::Krb5::parse_name($uname.'@'.$contentpwd);
     my $krbservice="krbtgt/".$contentpwd."\@".$contentpwd;
     my $krbserver=&Authen::Krb5::parse_name($krbservice);
     my $credentials=&Authen::Krb5::cc_default();
     $credentials->initialize($krbclient);
     my $krbreturn = 
       &Authen::Krb5::get_in_tkt_with_password(
        $krbclient,$krbserver,$upass,$credentials);
   #  unless ($krbreturn) {
   #      &logthis("Krb5 Error: ".
   #       &Authen::Krb5::error());
   #  }
     $pwdcorrect = ($krbreturn == 1);
      } else { $pwdcorrect=0; }
                           } elsif ($howpwd eq 'localauth') {                            } elsif ($howpwd eq 'localauth') {
     $pwdcorrect=&localauth::localauth($uname,$upass,      $pwdcorrect=&localauth::localauth($uname,$upass,
       $contentpwd);        $contentpwd);
Line 737  sub make_new_child { Line 758  sub make_new_child {
      }       }
 # -------------------------------------------------------------------- makeuser  # -------------------------------------------------------------------- makeuser
                    } elsif ($userinput =~ /^makeuser/) {                     } elsif ($userinput =~ /^makeuser/) {
        &Debug("Make user received");
                 my $oldumask=umask(0077);                  my $oldumask=umask(0077);
      if ($wasenc==1) {       if ($wasenc==1) {
                        my                          my 
                        ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);                         ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
          &Debug("cmd =".$cmd." $udom =".$udom.
       " uname=".$uname);
                        chomp($npass);                         chomp($npass);
                        $npass=&unescape($npass);                         $npass=&unescape($npass);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $passfilename="$proname/passwd";                         my $passfilename="$proname/passwd";
          &Debug("Password file created will be:".
       $passfilename);
                        if (-e $passfilename) {                         if (-e $passfilename) {
    print $client "already_exists\n";     print $client "already_exists\n";
                        } elsif ($udom ne $perlvar{'lonDefDomain'}) {                         } elsif ($udom ne $perlvar{'lonDefDomain'}) {
Line 762  sub make_new_child { Line 788  sub make_new_child {
                                }                                 }
                            }                             }
                            unless ($fperror) {                             unless ($fperror) {
      if ($umode eq 'krb4') {         my $result=&make_passwd_file($umode,$npass,
                                {       $passfilename);
                                  my $pf = IO::File->new(">$passfilename");         print $client $result;
             print $pf "krb4:$npass\n";   
                                }               
                                print $client "ok\n";  
                              } elsif ($umode eq 'internal') {  
        my $salt=time;  
                                $salt=substr($salt,6,2);  
        my $ncpass=crypt($npass,$salt);  
                                {   
                                  my $pf = IO::File->new(">$passfilename");  
             print $pf "internal:$ncpass\n";   
                                }  
                                print $client "ok\n";  
      } elsif ($umode eq 'localauth') {  
        {  
  my $pf = IO::File->new(">$passfilename");  
             print $pf "localauth:$npass\n";  
        }  
        print $client "ok\n";  
      } elsif ($umode eq 'unix') {  
        {  
  my $execpath="$perlvar{'lonDaemons'}/".  
               "lcuseradd";  
  {  
      my $se = IO::File->new("|$execpath");  
      print $se "$uname\n";  
      print $se "$npass\n";  
      print $se "$npass\n";  
  }  
                                  my $pf = IO::File->new(">$passfilename");  
             print $pf "unix:\n";   
        }  
        print $client "ok\n";  
      } elsif ($umode eq 'none') {  
                                {   
                                  my $pf = IO::File->new(">$passfilename");  
             print $pf "none:\n";   
                                }               
                                print $client "ok\n";  
                              } else {  
                                print $client "auth_mode_error\n";  
                              }    
                            } else {                             } else {
                                print $client "$fperror\n";                                 print $client "$fperror\n";
                            }                             }
Line 816  sub make_new_child { Line 801  sub make_new_child {
      umask($oldumask);       umask($oldumask);
 # -------------------------------------------------------------- changeuserauth  # -------------------------------------------------------------- changeuserauth
                    } elsif ($userinput =~ /^changeuserauth/) {                     } elsif ($userinput =~ /^changeuserauth/) {
      if ($wasenc==1) {         &Debug("Changing authorization");
         if ($wasenc==1) {
                        my                          my 
                        ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);         ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
                        chomp($npass);                         chomp($npass);
          &Debug("cmd = ".$cmd." domain= ".$udom.
         "uname =".$uname." umode= ".$umode);
                        $npass=&unescape($npass);                         $npass=&unescape($npass);
                        my $proname=propath($udom,$uname);                         my $proname=&propath($udom,$uname);
                        my $passfilename="$proname/passwd";                         my $passfilename="$proname/passwd";
        if ($udom ne $perlvar{'lonDefDomain'}) {         if ($udom ne $perlvar{'lonDefDomain'}) {
                            print $client "not_right_domain\n";                             print $client "not_right_domain\n";
                        } else {                         } else {
    if ($umode eq 'krb4') {     &make_passwd_file($umode,$npass,$passfilename);
                                {      print $client $result;
    my $pf = IO::File->new(">$passfilename");  
    print $pf "krb4:$npass\n";   
                                }               
                                print $client "ok\n";  
    } elsif ($umode eq 'internal') {  
        my $salt=time;  
                                $salt=substr($salt,6,2);  
        my $ncpass=crypt($npass,$salt);  
                                {   
    my $pf = IO::File->new(">$passfilename");  
    print $pf "internal:$ncpass\n";   
                                }  
                                print $client "ok\n";  
    } elsif ($umode eq 'localauth') {  
        {  
    my $pf = IO::File->new(">$passfilename");  
    print $pf "localauth:$npass\n";  
        }  
        print $client "ok\n";  
    } elsif ($umode eq 'unix') {  
        {  
    my $execpath="$perlvar{'lonDaemons'}/".  
        "lcuseradd";  
    {  
        my $se = IO::File->new("|$execpath");  
        print $se "$uname\n";  
        print $se "$npass\n";  
        print $se "$npass\n";  
    }  
    my $pf = IO::File->new(">$passfilename");  
    print $pf "unix:\n";   
        }  
        print $client "ok\n";  
    } elsif ($umode eq 'none') {  
                                {   
    my $pf = IO::File->new(">$passfilename");  
    print $pf "none:\n";   
                                }               
                                print $client "ok\n";  
    } else {  
                                print $client "auth_mode_error\n";  
    }    
                        }                         }
      } else {       } else {
        print $client "refused\n";         print $client "refused\n";
Line 936  sub make_new_child { Line 882  sub make_new_child {
        } else {         } else {
  print $client "rejected\n";   print $client "rejected\n";
                        }                         }
   # -------------------------------------- fetch a user file from a remote server
                      } elsif ($userinput =~ /^fetchuserfile/) {
                         my ($cmd,$fname)=split(/:/,$userinput);
         my ($udom,$uname,$ufile)=split(/\//,$fname);
                         my $udir=propath($udom,$uname).'/userfiles';
                         unless (-e $udir) { mkdir($udir,0770); }
                          if (-e $udir) {
                          $ufile=~s/^[\.\~]+//;
                          $ufile=~s/\///g;
                          my $transname=$udir.'/'.$ufile;
                          my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
                                my $response;
                                 {
                                my $ua=new LWP::UserAgent;
                                my $request=new HTTP::Request('GET',"$remoteurl");
                                $response=$ua->request($request,$transname);
         }
                                if ($response->is_error()) {
    unlink($transname);
                                    my $message=$response->status_line;
                                    &logthis(
                                     "LWP GET: $message for $fname ($remoteurl)");
    print $client "failed\n";
                                } else {
                                    print $client "ok\n";
                                }
                        } else {
                          print $client "not_home\n";
                        } 
   # ------------------------------------------ authenticate access to a user file
                      } elsif ($userinput =~ /^tokenauthuserfile/) {
                          my ($cmd,$fname,$session)=split(/:/,$userinput);
                          chomp($session);
                          $reply='non_auth';
                          if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.
                                         $session.'.id')) {
                           while ($line=<ENVIN>) {
      if ($line=~/userfile\.$fname\=/) { $reply='ok'; }
                           }
                           close(ENVIN);
                           print $client $reply."\n";
          } else {
    print $client "invalid_token\n";
                          }
 # ----------------------------------------------------------------- unsubscribe  # ----------------------------------------------------------------- unsubscribe
                    } elsif ($userinput =~ /^unsub/) {                     } elsif ($userinput =~ /^unsub/) {
                        my ($cmd,$fname)=split(/:/,$userinput);                         my ($cmd,$fname)=split(/:/,$userinput);
                        if (-e $fname) {                         if (-e $fname) {
                            if (unlink("$fname.$hostid{$clientip}")) {     print $client &unsub($client,$fname,$clientip);
                               print $client "ok\n";  
    } else {  
                               print $client "not_subscribed\n";  
    }  
                        } else {                         } else {
    print $client "not_found\n";     print $client "not_found\n";
                        }                         }
 # ------------------------------------------------------------------- subscribe  # ------------------------------------------------------------------- subscribe
                    } elsif ($userinput =~ /^sub/) {                     } elsif ($userinput =~ /^sub/) {
                        my ($cmd,$fname)=split(/:/,$userinput);         print $client &subscribe($userinput,$clientip);
                        my $ownership=ishome($fname);  
                        if ($ownership eq 'owner') {  
                         if (-e $fname) {  
  if (-d $fname) {  
    print $client "directory\n";  
                          } else {  
                            $now=time;  
                            {   
     my $sh;  
                             if ($sh=  
                              IO::File->new(">$fname.$hostid{$clientip}")) {  
                                print $sh "$clientip:$now\n";  
     }  
    }  
                            unless ($fname=~/\.meta$/) {  
        unlink("$fname.meta.$hostid{$clientip}");  
                            }  
                            $fname=~s/\/home\/httpd\/html\/res/raw/;  
                            $fname="http://$thisserver/".$fname;  
                            print $client "$fname\n";  
          }  
                         } else {  
          print $client "not_found\n";  
                         }  
        } else {  
                         print $client "rejected\n";  
        }  
 # ------------------------------------------------------------------------- log  # ------------------------------------------------------------------------- log
                    } elsif ($userinput =~ /^log/) {                     } elsif ($userinput =~ /^log/) {
                        my ($cmd,$udom,$uname,$what)=split(/:/,$userinput);                         my ($cmd,$udom,$uname,$what)=split(/:/,$userinput);
Line 1028  sub make_new_child { Line 987  sub make_new_child {
                       }                        }
 # -------------------------------------------------------------------- rolesput  # -------------------------------------------------------------------- rolesput
                    } elsif ($userinput =~ /^rolesput/) {                     } elsif ($userinput =~ /^rolesput/) {
          &Debug("rolesput");
     if ($wasenc==1) {      if ($wasenc==1) {
                        my ($cmd,$exedom,$exeuser,$udom,$uname,$what)                         my ($cmd,$exedom,$exeuser,$udom,$uname,$what)
                           =split(/:/,$userinput);                            =split(/:/,$userinput);
          &Debug("cmd = ".$cmd." exedom= ".$exedom.
       "user = ".$exeuser." udom=".$udom.
       "what = ".$what);
                        my $namespace='roles';                         my $namespace='roles';
                        chomp($what);                         chomp($what);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
Line 1047  sub make_new_child { Line 1010  sub make_new_child {
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
                            foreach $pair (@pairs) {                             foreach $pair (@pairs) {
        ($key,$value)=split(/=/,$pair);         ($key,$value)=split(/=/,$pair);
          &ManagePermissions($key, $udom, $uname,
     &GetAuthType( $udom, 
    $uname));
                                $hash{$key}=$value;                                 $hash{$key}=$value;
          
                            }                             }
    if (untie(%hash)) {     if (untie(%hash)) {
                               print $client "ok\n";                                print $client "ok\n";
Line 1182  sub make_new_child { Line 1149  sub make_new_child {
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $qresult='';                         my $qresult='';
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
                              study($regexp);
                            foreach $key (keys %hash) {                             foreach $key (keys %hash) {
                                if (eval('$key=~/$regexp/')) {                                 my $unescapeKey = &unescape($key);
                                  if (eval('$unescapeKey=~/$regexp/')) {
                                   $qresult.="$key=$hash{$key}&";                                    $qresult.="$key=$hash{$key}&";
        }                                }
                            }                             }
    if (untie(%hash)) {     if (untie(%hash)) {
               $qresult=~s/\&$//;                $qresult=~s/\&$//;
Line 1270  sub make_new_child { Line 1239  sub make_new_child {
                        } else {                         } else {
                            print $client "error:$!\n";                             print $client "error:$!\n";
                        }                         }
   # -------------------------------------------------------------------- chatsend
                      } elsif ($userinput =~ /^chatsend/) {
                          my ($cmd,$cdom,$cnum,$newpost)=split(/\:/,$userinput);
                          &chatadd($cdom,$cnum,$newpost);
                          print $client "ok\n";
   # -------------------------------------------------------------------- chatretr
                      } elsif ($userinput =~ /^chatretr/) {
                          my ($cmd,$cdom,$cnum)=split(/\:/,$userinput);
                          my $reply='';
                          foreach (&getchat($cdom,$cnum)) {
      $reply.=&escape($_).':';
                          }
                          $reply=~s/\:$//;
                          print $client $reply."\n";
 # ------------------------------------------------------------------- querysend  # ------------------------------------------------------------------- querysend
                    } elsif ($userinput =~ /^querysend/) {                     } elsif ($userinput =~ /^querysend/) {
                        my ($cmd,$query,                         my ($cmd,$query,
    $custom,$customshow)=split(/:/,$userinput);     $arg1,$arg2,$arg3)=split(/\:/,$userinput);
        $query=~s/\n*$//g;         $query=~s/\n*$//g;
        unless ($custom or $customshow) {         print $client "".
    print $client "".  
        sqlreply("$hostid{$clientip}\&$query")."\n";  
        }  
        else {  
    print $client "".  
        sqlreply("$hostid{$clientip}\&$query".         sqlreply("$hostid{$clientip}\&$query".
  "\&$custom"."\&$customshow")."\n";   "\&$arg1"."\&$arg2"."\&$arg3")."\n";
        }  
 # ------------------------------------------------------------------ queryreply  # ------------------------------------------------------------------ queryreply
                    } elsif ($userinput =~ /^queryreply/) {                     } elsif ($userinput =~ /^queryreply/) {
                        my ($cmd,$id,$reply)=split(/:/,$userinput);                          my ($cmd,$id,$reply)=split(/:/,$userinput); 
Line 1389  sub make_new_child { Line 1366  sub make_new_child {
                        my $ulsout='';                         my $ulsout='';
                        my $ulsfn;                         my $ulsfn;
                        if (-e $ulsdir) {                         if (-e $ulsdir) {
  if (opendir(LSDIR,$ulsdir)) {                             if(-d $ulsdir) {
                           while ($ulsfn=readdir(LSDIR)) {                                 if (opendir(LSDIR,$ulsdir)) {
      my @ulsstats=stat($ulsdir.'/'.$ulsfn);                                     while ($ulsfn=readdir(LSDIR)) {
                              $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';                                         my @ulsstats=stat($ulsdir.'/'.$ulsfn);
                           }                                         $ulsout.=$ulsfn.'&'.
                           closedir(LSDIR);                                                  join('&',@ulsstats).':';
         }                                     }
        } else {                                     closedir(LSDIR);
                                  }
                              } else {
                                  my @ulsstats=stat($ulsdir);
                                  $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
                              }
                          } else {
                           $ulsout='no_such_dir';                            $ulsout='no_such_dir';
                        }                         }
                        if ($ulsout eq '') { $ulsout='empty'; }                         if ($ulsout eq '') { $ulsout='empty'; }
Line 1442  sub make_new_child { Line 1425  sub make_new_child {
     }      }
 }  }
   
   
   #
   #   Checks to see if the input roleput request was to set
   # an author role.  If so, invokes the lchtmldir script to set
   # up a correct public_html 
   # Parameters:
   #    request   - The request sent to the rolesput subchunk.
   #                We're looking for  /domain/_au
   #    domain    - The domain in which the user is having roles doctored.
   #    user      - Name of the user for which the role is being put.
   #    authtype  - The authentication type associated with the user.
   #
   sub ManagePermissions
   {
       my $request = shift;
       my $domain  = shift;
       my $user    = shift;
       my $authtype= shift;
   
       # See if the request is of the form /$domain/_au
   
       if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput...
    my $execdir = $perlvar{'lonDaemons'};
    my $userhome= "/home/$user" ;
    Debug("system $execdir/lchtmldir $userhome $system $authtype");
    system("$execdir/lchtmldir $userhome $user $authtype");
       }
   }
   #
   #   GetAuthType - Determines the authorization type of a user in a domain.
   
   #     Returns the authorization type or nouser if there is no such user.
   #
   sub GetAuthType 
   {
       my $domain = shift;
       my $user   = shift;
   
       Debug("GetAuthType( $domain, $user ) \n");
       my $proname    = &propath($domain, $user); 
       my $passwdfile = "$proname/passwd";
       if( -e $passwdfile ) {
    my $pf = IO::File->new($passwdfile);
    my $realpassword = <$pf>;
    chomp($realpassword);
    Debug("Password info = $realpassword\n");
    my ($authtype, $contentpwd) = split(/:/, $realpassword);
    Debug("Authtype = $authtype, content = $contentpwd\n");
    my $availinfo = '';
    if($authtype eq 'krb4' or $authtype eq 'krb5') {
       $availinfo = $contentpwd;
    }
   
    return "$authtype:$availinfo";
       }
       else {
    Debug("Returning nouser");
    return "nouser";
       }
   }
   
   sub addline {
       my ($fname,$hostid,$ip,$newline)=@_;
       my $contents;
       my $found=0;
       my $expr='^'.$hostid.':'.$ip.':';
       $expr =~ s/\./\\\./g;
       if ($sh=IO::File->new("$fname.subscription")) {
    while (my $subline=<$sh>) {
       if ($subline !~ /$expr/) {$contents.= $subline;} else {$found=1;}
    }
    $sh->close();
       }
       $sh=IO::File->new(">$fname.subscription");
       if ($contents) { print $sh $contents; }
       if ($newline) { print $sh $newline; }
       $sh->close();
       return $found;
   }
   
   sub getchat {
       my ($cdom,$cname)=@_;
       my %hash;
       my $proname=&propath($cdom,$cname);
       my @entries=();
       if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
       &GDBM_READER(),0640)) {
    @entries=map { $_.':'.$hash{$_} } sort keys %hash;
    untie %hash;
       }
       return @entries;
   }
   
   sub chatadd {
       my ($cdom,$cname,$newchat)=@_;
       my %hash;
       my $proname=&propath($cdom,$cname);
       my @entries=();
       if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
       &GDBM_WRCREAT(),0640)) {
    @entries=map { $_.':'.$hash{$_} } sort keys %hash;
    my $time=time;
    my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);
    my ($thentime,$idnum)=split(/\_/,$lastid);
    my $newid=$time.'_000000';
    if ($thentime==$time) {
       $idnum=~s/^0+//;
       $idnum++;
       $idnum=substr('000000'.$idnum,-6,6);
       $newid=$time.'_'.$idnum;
    }
    $hash{$newid}=$newchat;
    my $expired=$time-3600;
    foreach (keys %hash) {
       my ($thistime)=($_=~/(\d+)\_/);
       if ($thistime<$expired) {
    delete $hash{$_};
       }
    }
    untie %hash;
       }
   }
   
   sub unsub {
       my ($fname,$clientip)=@_;
       my $result;
       if (unlink("$fname.$hostid{$clientip}")) {
    $result="ok\n";
       } else {
    $result="not_subscribed\n";
       }
       if (-e "$fname.subscription") {
    my $found=&addline($fname,$hostid{$clientip},$clientip,'');
    if ($found) { $result="ok\n"; }
       } else {
    if ($result != "ok\n") { $result="not_subscribed\n"; }
       }
       return $result;
   }
   
   sub subscribe {
       my ($userinput,$clientip)=@_;
       my $result;
       my ($cmd,$fname)=split(/:/,$userinput);
       my $ownership=&ishome($fname);
       if ($ownership eq 'owner') {
    if (-e $fname) {
       if (-d $fname) {
    $result="directory\n";
       } else {
    if (-e "$fname.$hostid{$clientip}") {&unsub($fname,$clientip);}
    $now=time;
    my $found=&addline($fname,$hostid{$clientip},$clientip,
      "$hostid{$clientip}:$clientip:$now\n");
    if ($found) { $result="$fname\n"; }
    # if they were subscribed to only meta data, delete that
                   # subscription, when you subscribe to a file you also get
                   # the metadata
    unless ($fname=~/\.meta$/) { &unsub("$fname.meta",$clientip); }
    $fname=~s/\/home\/httpd\/html\/res/raw/;
    $fname="http://$thisserver/".$fname;
    $result="$fname\n";
       }
    } else {
       $result="not_found\n";
    }
       } else {
    $result="rejected\n";
       }
       return $result;
   }
   
   sub make_passwd_file {
       my ($umode,$npass,$passfilename)=@_;
       my $result="ok\n";
       if ($umode eq 'krb4' or $umode eq 'krb5') {
    {
       my $pf = IO::File->new(">$passfilename");
       print $pf "$umode:$npass\n";
    }
       } elsif ($umode eq 'internal') {
    my $salt=time;
    $salt=substr($salt,6,2);
    my $ncpass=crypt($npass,$salt);
    {
       &Debug("Creating internal auth");
       my $pf = IO::File->new(">$passfilename");
       print $pf "internal:$ncpass\n"; 
    }
       } elsif ($umode eq 'localauth') {
    {
       my $pf = IO::File->new(">$passfilename");
       print $pf "localauth:$npass\n";
    }
       } elsif ($umode eq 'unix') {
    {
       my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd";
       {
    &Debug("Executing external: ".$execpath);
    my $se = IO::File->new("|$execpath");
    print $se "$uname\n";
    print $se "$npass\n";
    print $se "$npass\n";
       }
       my $pf = IO::File->new(">$passfilename");
       print $pf "unix:\n";
    }
       } elsif ($umode eq 'none') {
    {
       my $pf = IO::File->new(">$passfilename");
       print $pf "none:\n";
    }
       } else {
    $result="auth_mode_error\n";
       }
       return $result;
   }
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
   
 =head1 NAME  =head1 NAME
Line 1740  Crypt::IDEA Line 1941  Crypt::IDEA
 LWP::UserAgent()  LWP::UserAgent()
 GDBM_File  GDBM_File
 Authen::Krb4  Authen::Krb4
   Authen::Krb5
   
 =head1 COREQUISITES  =head1 COREQUISITES
   
Removed from v.1.76  
changed lines
  Added in v.1.92

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.