[BACK]Return to expire_DC_role.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / build

Diff for /loncom/build/expire_DC_role.pl between versions 1.1 and 1.6

version 1.1, 2011/03/07 23:13:40 version 1.6, 2015/03/10 20:19:14
Line 70  use LONCAPA; Line 70  use LONCAPA;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon;  use Apache::loncommon;
 use Apache::lonlocal;  use Apache::lonlocal;
 &Apache::lonlocal::get_language_handle();  use Storable qw(nfreeze);
   
 =pod  =pod
   
Line 87  The second argument specifies the domain Line 87  The second argument specifies the domain
   
 =cut  =cut
   
   my ($user,$role_domain) = (@ARGV);
   my $lang = &Apache::lonlocal::choose_language();
   &Apache::lonlocal::get_language_handle(undef,$lang);
   
   if ($< != 0) { # Am I root?
       print(&mt('You must be root in order to expire a domain coordinator role.').
             "\n");
       exit;
   }
 # ----------------------------------------------- So, are we invoked correctly?  # ----------------------------------------------- So, are we invoked correctly?
 # Two arguments or abort  # Two arguments or abort
 if (@ARGV!=2) {  if (@ARGV!=2) {
     die('usage: expire_DC_role.pl [USERNAME:DOMAIN] [DC ROLEDOMAIN]'.      print(&mt('usage: [_1]','expire_DC_role.pl [USERNAME:DOMAIN] [DC ROLEDOMAIN]').
  "\n");   "\n");
       exit;
 }  }
 my ($user,$role_domain)=(@ARGV);  my ($user,$role_domain)=(@ARGV);
 my ($username,$domain)=split(':',$user);  my ($username,$domain)=split(':',$user);
 if (!grep(/^\Q$role_domain\E$/,&Apache::lonnet::current_machine_domains())) {  if (!grep(/^\Q$role_domain\E$/,&Apache::lonnet::current_machine_domains())) {
     die('**** ERROR **** Domain '.$role_domain.' is not a domain for which this server is a library server.'."\n");      print(&mt('**** ERROR **** Domain [_1] is not a domain for which this server is a library server.',$role_domain)."\n");
       exit;
 }  }
   
 my $udpath=&propath($domain,$username);  my $udpath=&propath($domain,$username);
 if (!-d $udpath) {  if (!-d $udpath) {
     die ('**** ERROR **** '.$user.' is not a LON-CAPA user for which this is the homeserver.'."\n");      print(&mt('**** ERROR **** [_1] is not a LON-CAPA user for which this is the homeserver.',$user)."\n");
       exit;
 }  }
   
 use GDBM_File; # A simple key-value pairing database.  use GDBM_File; # A simple key-value pairing database.
   
 my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());  my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
 if (!$rolesref) {  if (!$rolesref) {
     die('unable to tie roles db: '."$udpath/roles.db");      print(&mt('unable to tie [_1]',"roles db: $udpath/roles.db")."\n");
       exit;
 }  }
 my ($start,$status,$now);  my ($start,$status,$now);
 $now = time();  $now = time();
Line 175  my $dompath = $perlvar{'lonUsersDir'}.'/ Line 188  my $dompath = $perlvar{'lonUsersDir'}.'/
 my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());  my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());
   
 if (!$domrolesref) {  if (!$domrolesref) {
     die('unable to tie nohist_domainroles db: '."$dompath/nohist_domainroles.db");      print(&mt('unable to tie [_1]',"nohist_domainroles db: $dompath/nohist_domainroles.db")."\n");
       exit;
 }  }
   
 # Store in nohist_domainroles.db  # Store in nohist_domainroles.db
Line 186  $domrolesref->{$domkey}= &LONCAPA::escap Line 200  $domrolesref->{$domkey}= &LONCAPA::escap
  system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process.   system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process.
  system('/bin/chown',"www:www","$dompath/nohist_domainroles.db.lock");   system('/bin/chown',"www:www","$dompath/nohist_domainroles.db.lock");
   
   # Log with domainconfiguser in nohist_rolelog.db
   my $domconfiguser = $domain.'-domainconfig';
   my $subdir = $domconfiguser;
   $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
   
   my $rolelogref = &LONCAPA::locking_hash_tie("$dompath/$subdir/$domconfiguser/nohist_rolelog.db",&GDBM_WRCREAT());
   
   if (!$rolelogref) {
       print(&mt('unable to tie [_1]',"nohist_rolelog db: $dompath/$subdir/$domconfiguser/nohist_rolelog.db")."\n");
       exit;
   }
   
   my $domlogkey = &LONCAPA::escape($now.'00000'.$$.'000000');
   my $storehash = {
                      role    => 'dc',
                      start   => $start,
                      end     => $now,
                      context => 'server',
                   };
   my $domlogvalue = {
                       'exe_uname' => '',
                       'exe_udom'  => $domain,
                       'exe_time'  => $now,
                       'exe_ip'    => '127.0.0.1',
                       'delflag'   => '',
                       'logentry'  => $storehash,
                       'uname'     => $username,
                       'udom'      => $domain,
                    };
   $rolelogref->{$domlogkey}=&freeze_escape($domlogvalue);
   &LONCAPA::locking_hash_untie($rolelogref);
   
    system('/bin/chown',"www:www","$dompath/$subdir/$domconfiguser/nohist_rolelog.db"); # Must be writeable by httpd process.
    system('/bin/chown',"www:www","$dompath/$subdir/$domconfiguser/nohist_rolelog.db.lock");
   
 # Output success message.  # Output success message.
 print(&mt('User: [_1], domain coordinator role expired in domain: [_2].',$user,$role_domain)."\n");  print(&mt('User: [_1], domain coordinator role expired in domain: [_2].',$user,$role_domain)."\n");
   
   sub freeze_escape {
       my ($value)=@_;
       if (ref($value)) {
           $value=&nfreeze($value);
           return '__FROZEN__'.&LONCAPA::escape($value);
       }
       return &LONCAPA::escape($value);
   }
   
   exit;
Removed from v.1.1  
changed lines
  Added in v.1.6

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>