Annotation of loncom/Lond.pm, revision 1.22

1.1       droeschl    1: # The LearningOnline Network
                      2: #
1.22    ! raeburn     3: # $Id: Lond.pm,v 1.21 2022/02/17 22:35:50 raeburn Exp $
1.1       droeschl    4: #
                      5: # Copyright Michigan State University Board of Trustees
                      6: #
                      7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      8: #
                      9: # LON-CAPA is free software; you can redistribute it and/or modify
                     10: # it under the terms of the GNU General Public License as published by
                     11: # the Free Software Foundation; either version 2 of the License, or
                     12: # (at your option) any later version.
                     13: #
                     14: # LON-CAPA is distributed in the hope that it will be useful,
                     15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     17: # GNU General Public License for more details.
                     18: #
                     19: # You should have received a copy of the GNU General Public License
                     20: # along with LON-CAPA; if not, write to the Free Software
                     21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     22: #
                     23: # /home/httpd/html/adm/gpl.txt
                     24: #
                     25: # http://www.lon-capa.org/
                     26: #
                     27: ###
                     28: 
                     29: #NOTE perldoc at the end of file
1.4       droeschl   30: #TODO move remaining lond functions into this
1.1       droeschl   31: 
                     32: package LONCAPA::Lond;
                     33: 
                     34: use strict;
                     35: use lib '/home/httpd/lib/perl/';
                     36: 
                     37: use LONCAPA;
                     38: use Apache::lonnet;
                     39: use GDBM_File;
1.15      raeburn    40: use MIME::Base64;
1.9       raeburn    41: use Crypt::OpenSSL::X509;
1.15      raeburn    42: use Crypt::X509::CRL;
1.12      raeburn    43: use Crypt::PKCS10;
1.18      raeburn    44: use Net::OAuth;
1.20      raeburn    45: use Crypt::CBC;
1.22    ! raeburn    46: use Net::OAuth;
        !            47: use Digest::SHA;
        !            48: use Digest::MD5 qw(md5_hex);
1.1       droeschl   49: 
                     50: sub dump_with_regexp {
1.4       droeschl   51:     my ( $tail, $clientversion ) = @_;
1.2       droeschl   52:     my ( $udom, $uname, $namespace, $regexp, $range ) = 
                     53:         split /:/, $tail;
1.1       droeschl   54: 
1.4       droeschl   55:     $regexp = $regexp ? unescape($regexp) : '.';
1.1       droeschl   56: 
                     57:     my ($start,$end);
1.2       droeschl   58: 
1.1       droeschl   59:     if (defined($range)) {
1.2       droeschl   60:         if ($range =~ /^(\d+)\-(\d+)$/) {
                     61:             ($start,$end) = ($1,$2);
                     62:         } elsif ($range =~/^(\d+)$/) {
                     63:             ($start,$end) = (0,$1);
                     64:         } else {
                     65:             undef($range);
                     66:         }
                     67:     }
                     68: 
                     69:     my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER()) or 
                     70:         return "error: ".($!+0)." tie(GDBM) Failed while attempting dump";
                     71: 
                     72:     my $qresult = '';
                     73:     my $count = 0;
1.1       droeschl   74: #
                     75: # When dump is for roles.db, determine if LON-CAPA version checking is needed.
1.2       droeschl   76: # Sessions on 2.10 and later do not require version checking, as that occurs
1.1       droeschl   77: # on the server hosting the user session, when constructing the roles/courses 
                     78: # screen).
                     79: # 
1.2       droeschl   80:     my $skipcheck;
                     81:     my @ids = &Apache::lonnet::current_machine_ids();
                     82:     my (%homecourses, $major, $minor, $now);
1.1       droeschl   83: # 
                     84: # If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA   
1.2       droeschl   85: # version on the server which requested the data. 
1.1       droeschl   86: # 
1.2       droeschl   87:     if ($namespace eq 'roles') {
                     88:         if ($clientversion =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
                     89:             $major = $1;
                     90:             $minor = $2;
1.4       droeschl   91: 
1.2       droeschl   92:         }
                     93:         if (($major > 2) || (($major == 2) && ($minor > 9))) {
                     94:             $skipcheck = 1;
1.1       droeschl   95:         }
1.2       droeschl   96:         $now = time;
                     97:     }
                     98:     while (my ($key,$value) = each(%$hashref)) {
                     99:             if ($namespace eq 'roles' && (!$skipcheck)) {
1.1       droeschl  100:                 if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {
                    101:                     my $cdom = $1;
                    102:                     my $cnum = $2;
1.2       droeschl  103:                     my ($role,$roleend,$rolestart) = split(/\_/,$value);
                    104:                     if (!$roleend || $roleend > $now) {
1.1       droeschl  105: #
                    106: # For active course roles, check that requesting server is running a LON-CAPA
                    107: # version which meets any version requirements for the course. Do not include
                    108: # the role amongst the results returned if the requesting server's version is
                    109: # too old.
                    110: #
                    111: # This determination is handled differently depending on whether the course's 
                    112: # homeserver is the current server, or whether it is a different server.
                    113: # In both cases, the course's version requirement needs to be retrieved.
                    114: # 
1.2       droeschl  115:                         next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
                    116:                                                         $minor,\%homecourses,\@ids));
1.1       droeschl  117:                     }
                    118:                 }
                    119:             }
1.2       droeschl  120:         if ($regexp eq '.') {
                    121:             $count++;
                    122:             if (defined($range) && $count >= $end)   { last; }
                    123:             if (defined($range) && $count <  $start) { next; }
                    124:             $qresult.=$key.'='.$value.'&';
                    125:         } else {
                    126:             my $unescapeKey = &unescape($key);
                    127:             if (eval('$unescapeKey=~/$regexp/')) {
                    128:                 $count++;
                    129:                 if (defined($range) && $count >= $end)   { last; }
                    130:                 if (defined($range) && $count <  $start) { next; }
                    131:                 $qresult.="$key=$value&";
                    132:             }
                    133:         }
                    134:     }
                    135: 
                    136:     &untie_user_hash($hashref) or 
                    137:         return "error: ".($!+0)." untie(GDBM) Failed while attempting dump";
1.1       droeschl  138: #
                    139: # If dump is for roles.db from a pre-2.10 server, check if the LON-CAPA
                    140: # version requirements for courses for which the current server is the home
                    141: # server permit course roles to be usable on the client server hosting the
                    142: # user's session. If so, include those role results in the data returned to  
                    143: # the client server.
                    144: #
1.2       droeschl  145:     if (($namespace eq 'roles') && (!$skipcheck)) {
                    146:         if (keys(%homecourses) > 0) {
                    147:             $qresult .= &check_homecourses(\%homecourses,$regexp,$count,
                    148:                                            $range,$start,$end,$major,$minor);
                    149:         }
                    150:     }
                    151:     chop($qresult);
                    152:     return $qresult;
                    153: }
                    154: 
                    155: 
                    156: sub releasereqd_check {
                    157:     my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_;
                    158:     my $home = &Apache::lonnet::homeserver($cnum,$cdom);
                    159:     return if ($home eq 'no_host');
                    160:     my ($reqdmajor,$reqdminor,$displayrole);
                    161:     if ($cnum =~ /$LONCAPA::match_community/) {
                    162:         if ($major eq '' && $minor eq '') {
                    163:             return unless ((ref($ids) eq 'ARRAY') && 
                    164:                            (grep(/^\Q$home\E$/,@{$ids})));
                    165:         } else {
                    166:             $reqdmajor = 2;
                    167:             $reqdminor = 9;
                    168:             return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
                    169:         }
                    170:     }
                    171:     my $hashid = $cdom.':'.$cnum;
                    172:     my ($courseinfo,$cached) =
                    173:         &Apache::lonnet::is_cached_new('courseinfo',$hashid);
                    174:     if (defined($cached)) {
                    175:         if (ref($courseinfo) eq 'HASH') {
                    176:             if (exists($courseinfo->{'releaserequired'})) {
                    177:                 my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
                    178:                 return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
                    179:             }
                    180:         }
                    181:     } else {
                    182:         if (ref($ids) eq 'ARRAY') {
                    183:             if (grep(/^\Q$home\E$/,@{$ids})) {
                    184:                 if (ref($homecourses) eq 'HASH') {
                    185:                     if (ref($homecourses->{$cdom}) eq 'HASH') {
                    186:                         if (ref($homecourses->{$cdom}{$cnum}) eq 'HASH') {
                    187:                             if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
                    188:                                 push(@{$homecourses->{$cdom}{$cnum}},{$key=>$value});
                    189:                             } else {
                    190:                                 $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
                    191:                             }
                    192:                         } else {
                    193:                             $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
                    194:                         }
                    195:                     } else {
                    196:                         $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
                    197:                     }
                    198:                 }
                    199:                 return;
                    200:             }
                    201:         }
                    202:         my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
                    203:         if (ref($courseinfo) eq 'HASH') {
                    204:             if (exists($courseinfo->{'releaserequired'})) {
                    205:                 my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
                    206:                 return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
                    207:             }
                    208:         } else {
                    209:             return;
                    210:         }
                    211:     }
                    212:     return 1;
                    213: }
                    214: 
                    215: 
                    216: sub check_homecourses {
                    217:     my ($homecourses,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
                    218:     my ($result,%addtocache);
                    219:     my $yesterday = time - 24*3600; 
                    220:     if (ref($homecourses) eq 'HASH') {
                    221:         my (%okcourses,%courseinfo,%recent);
                    222:         foreach my $domain (keys(%{$homecourses})) {
                    223:             my $hashref = 
                    224:                 &tie_domain_hash($domain, "nohist_courseids", &GDBM_WRCREAT());
                    225:             if (ref($hashref) eq 'HASH') {
                    226:                 while (my ($key,$value) = each(%$hashref)) {
                    227:                     my $unesc_key = &unescape($key);
                    228:                     if ($unesc_key =~ /^lasttime:(\w+)$/) {
                    229:                         my $cid = $1;
                    230:                         $cid =~ s/_/:/;
                    231:                         if ($value > $yesterday ) {
                    232:                             $recent{$cid} = 1;
                    233:                         }
                    234:                         next;
                    235:                     }
                    236:                     my $items = &Apache::lonnet::thaw_unescape($value);
                    237:                     if (ref($items) eq 'HASH') {
                    238:                         my ($cdom,$cnum) = split(/_/,$unesc_key);
                    239:                         my $hashid = $cdom.':'.$cnum; 
                    240:                         $courseinfo{$hashid} = $items;
                    241:                         if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
                    242:                             my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
                    243:                             if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
                    244:                                $okcourses{$hashid} = 1;
                    245:                             }
                    246:                         }
                    247:                     }
                    248:                 }
                    249:                 unless (&untie_domain_hash($hashref)) {
1.17      raeburn   250:                     &Apache::lonnet::logthis("Failed to untie tied hash for nohist_courseids.db for $domain");
1.2       droeschl  251:                 }
                    252:             } else {
1.17      raeburn   253:                 &Apache::lonnet::logthis("Failed to tie hash for nohist_courseids.db for $domain");
1.2       droeschl  254:             }
                    255:         }
                    256:         foreach my $hashid (keys(%recent)) {
                    257:             my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
                    258:             unless ($cached) {
                    259:                 &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
                    260:             }
                    261:         }
                    262:         foreach my $cdom (keys(%{$homecourses})) {
                    263:             if (ref($homecourses->{$cdom}) eq 'HASH') {
                    264:                 foreach my $cnum (keys(%{$homecourses->{$cdom}})) {
                    265:                     my $hashid = $cdom.':'.$cnum;
                    266:                     next if ($recent{$hashid});
                    267:                     &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
                    268:                 }
                    269:             }
                    270:         }
                    271:         foreach my $hashid (keys(%okcourses)) {
                    272:             my ($cdom,$cnum) = split(/:/,$hashid);
                    273:             if ((ref($homecourses->{$cdom}) eq 'HASH') &&  
                    274:                 (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY')) {
                    275:                 foreach my $role (@{$homecourses->{$cdom}{$cnum}}) {
                    276:                     if (ref($role) eq 'HASH') {
                    277:                         while (my ($key,$value) = each(%{$role})) {
                    278:                             if ($regexp eq '.') {
                    279:                                 $count++;
                    280:                                 if (defined($range) && $count >= $end)   { last; }
                    281:                                 if (defined($range) && $count <  $start) { next; }
                    282:                                 $result.=$key.'='.$value.'&';
                    283:                             } else {
                    284:                                 my $unescapeKey = &unescape($key);
                    285:                                 if (eval('$unescapeKey=~/$regexp/')) {
                    286:                                     $count++;
                    287:                                     if (defined($range) && $count >= $end)   { last; }
                    288:                                     if (defined($range) && $count <  $start) { next; }
                    289:                                     $result.="$key=$value&";
                    290:                                 }
                    291:                             }
                    292:                         }
                    293:                     }
1.1       droeschl  294:                 }
                    295:             }
1.2       droeschl  296:         }
1.1       droeschl  297:     }
1.2       droeschl  298:     return $result;
                    299: }
                    300: 
1.1       droeschl  301: 
1.2       droeschl  302: sub useable_role {
                    303:     my ($reqdmajor,$reqdminor,$major,$minor) = @_; 
                    304:     if ($reqdmajor ne '' && $reqdminor ne '') {
                    305:         return if (($major eq '' && $minor eq '') ||
                    306:                    ($major < $reqdmajor) ||
                    307:                    (($major == $reqdmajor) && ($minor < $reqdminor)));
                    308:     }
1.1       droeschl  309:     return 1;
                    310: }
                    311: 
1.2       droeschl  312: 
1.3       droeschl  313: sub get_courseinfo_hash {
                    314:     my ($cnum,$cdom,$home) = @_;
                    315:     my %info;
                    316:     eval {
                    317:         local($SIG{ALRM}) = sub { die "timeout\n"; };
                    318:         local($SIG{__DIE__})='DEFAULT';
                    319:         alarm(3);
                    320:         %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');
                    321:         alarm(0);
                    322:     };
                    323:     if ($@) {
                    324:         if ($@ eq "timeout\n") {
1.17      raeburn   325:             &Apache::lonnet::logthis("<font color='blue'>WARNING courseiddump for $cnum:$cdom from $home timedout</font>");
1.3       droeschl  326:         } else {
1.17      raeburn   327:             &Apache::lonnet::logthis("<font color='yellow'>WARNING unexpected error during eval of call for courseiddump from $home</font>");
1.3       droeschl  328:         }
                    329:     } else {
                    330:         if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {
                    331:             my $hashid = $cdom.':'.$cnum;
                    332:             return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600);
                    333:         }
                    334:     }
                    335:     return;
                    336: }
1.2       droeschl  337: 
1.4       droeschl  338: sub dump_course_id_handler {
                    339:     my ($tail) = @_;
                    340: 
                    341:     my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
                    342:         $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
                    343:         $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,
1.7       raeburn   344:         $creationcontext,$domcloner,$hasuniquecode,$reqcrsdom,$reqinstcode) = split(/:/,$tail);
1.4       droeschl  345:     my $now = time;
                    346:     my ($cloneruname,$clonerudom,%cc_clone);
                    347:     if (defined($description)) {
                    348: 	$description=&unescape($description);
                    349:     } else {
                    350: 	$description='.';
                    351:     }
                    352:     if (defined($instcodefilter)) {
                    353:         $instcodefilter=&unescape($instcodefilter);
                    354:     } else {
                    355:         $instcodefilter='.';
                    356:     }
                    357:     my ($ownerunamefilter,$ownerdomfilter);
                    358:     if (defined($ownerfilter)) {
                    359:         $ownerfilter=&unescape($ownerfilter);
                    360:         if ($ownerfilter ne '.' && defined($ownerfilter)) {
                    361:             if ($ownerfilter =~ /^([^:]*):([^:]*)$/) {
                    362:                  $ownerunamefilter = $1;
                    363:                  $ownerdomfilter = $2;
                    364:             } else {
                    365:                 $ownerunamefilter = $ownerfilter;
                    366:                 $ownerdomfilter = '';
                    367:             }
                    368:         }
                    369:     } else {
                    370:         $ownerfilter='.';
                    371:     }
                    372: 
                    373:     if (defined($coursefilter)) {
                    374:         $coursefilter=&unescape($coursefilter);
                    375:     } else {
                    376:         $coursefilter='.';
                    377:     }
                    378:     if (defined($typefilter)) {
                    379:         $typefilter=&unescape($typefilter);
                    380:     } else {
                    381:         $typefilter='.';
                    382:     }
                    383:     if (defined($regexp_ok)) {
                    384:         $regexp_ok=&unescape($regexp_ok);
                    385:     }
                    386:     if (defined($catfilter)) {
                    387:         $catfilter=&unescape($catfilter);
                    388:     }
                    389:     if (defined($cloner)) {
                    390:         $cloner = &unescape($cloner);
                    391:         ($cloneruname,$clonerudom) = ($cloner =~ /^($LONCAPA::match_username):($LONCAPA::match_domain)$/); 
                    392:     }
                    393:     if (defined($cc_clone_list)) {
                    394:         $cc_clone_list = &unescape($cc_clone_list);
                    395:         my @cc_cloners = split('&',$cc_clone_list);
                    396:         foreach my $cid (@cc_cloners) {
                    397:             my ($clonedom,$clonenum) = split(':',$cid);
                    398:             next if ($clonedom ne $udom); 
                    399:             $cc_clone{$clonedom.'_'.$clonenum} = 1;
                    400:         } 
                    401:     }
                    402:     if ($createdbefore ne '') {
                    403:         $createdbefore = &unescape($createdbefore);
                    404:     } else {
                    405:        $createdbefore = 0;
                    406:     }
                    407:     if ($createdafter ne '') {
                    408:         $createdafter = &unescape($createdafter);
                    409:     } else {
                    410:         $createdafter = 0;
                    411:     }
                    412:     if ($creationcontext ne '') {
                    413:         $creationcontext = &unescape($creationcontext);
                    414:     } else {
                    415:         $creationcontext = '.';
                    416:     }
1.6       raeburn   417:     unless ($hasuniquecode) {
                    418:         $hasuniquecode = '.';
                    419:     }
1.8       raeburn   420:     if ($reqinstcode ne '') {
                    421:         $reqinstcode = &unescape($reqinstcode);
                    422:     }
1.4       droeschl  423:     my $unpack = 1;
                    424:     if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' && 
                    425:         $typefilter eq '.') {
                    426:         $unpack = 0;
                    427:     }
                    428:     if (!defined($since)) { $since=0; }
1.7       raeburn   429:     my (%gotcodedefaults,%otcodedefaults);
1.4       droeschl  430:     my $qresult='';
                    431: 
                    432:     my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT())
                    433:         or return "error: ".($!+0)." tie(GDBM) Failed while attempting courseiddump";
                    434: 
                    435: 	while (my ($key,$value) = each(%$hashref)) {
                    436:             my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,
                    437:                 %unesc_val,$selfenroll_end,$selfenroll_types,$created,
                    438:                 $context);
                    439:             $unesc_key = &unescape($key);
                    440:             if ($unesc_key =~ /^lasttime:/) {
                    441:                 next;
                    442:             } else {
                    443:                 $lasttime_key = &escape('lasttime:'.$unesc_key);
                    444:             }
                    445:             if ($hashref->{$lasttime_key} ne '') {
                    446:                 $lasttime = $hashref->{$lasttime_key};
                    447:                 next if ($lasttime<$since);
                    448:             }
1.7       raeburn   449:             my ($canclone,$valchange,$clonefromcode);
1.4       droeschl  450:             my $items = &Apache::lonnet::thaw_unescape($value);
                    451:             if (ref($items) eq 'HASH') {
                    452:                 if ($hashref->{$lasttime_key} eq '') {
                    453:                     next if ($since > 1);
                    454:                 }
1.7       raeburn   455:                 if ($items->{'inst_code'}) {
                    456:                     $clonefromcode = $items->{'inst_code'};
                    457:                 }
1.4       droeschl  458:                 $is_hash =  1;
                    459:                 if ($domcloner) {
                    460:                     $canclone = 1;
                    461:                 } elsif (defined($clonerudom)) {
                    462:                     if ($items->{'cloners'}) {
                    463:                         my @cloneable = split(',',$items->{'cloners'});
                    464:                         if (@cloneable) {
                    465:                             if (grep(/^\*$/,@cloneable))  {
                    466:                                 $canclone = 1;
                    467:                             } elsif (grep(/^\*:\Q$clonerudom\E$/,@cloneable)) {
                    468:                                 $canclone = 1;
                    469:                             } elsif (grep(/^\Q$cloneruname\E:\Q$clonerudom\E$/,@cloneable)) {
                    470:                                 $canclone = 1;
                    471:                             }
                    472:                         }
                    473:                         unless ($canclone) {
                    474:                             if ($cloneruname ne '' && $clonerudom ne '') {
                    475:                                 if ($cc_clone{$unesc_key}) {
                    476:                                     $canclone = 1;
                    477:                                     $items->{'cloners'} .= ','.$cloneruname.':'.
                    478:                                                            $clonerudom;
                    479:                                     $valchange = 1;
                    480:                                 }
                    481:                             }
                    482:                         }
1.7       raeburn   483:                         unless ($canclone) {
                    484:                             if (($reqcrsdom eq $udom) && ($reqinstcode) && ($clonefromcode)) {
                    485:                                 if (grep(/\=/,@cloneable))  {
                    486:                                     foreach my $cloner (@cloneable) {
                    487:                                         if (($cloner ne '*') && ($cloner !~ /^\*\:$LONCAPA::match_domain$/) &&
                    488:                                             ($cloner !~ /^$LONCAPA::match_username\:$LONCAPA::match_domain$/) && ($cloner ne '')) {
                    489:                                             if ($cloner =~ /=/) {
                    490:                                                 my (%codedefaults,@code_order);
                    491:                                                 if (ref($gotcodedefaults{$udom}) eq 'HASH') {
                    492:                                                     if (ref($gotcodedefaults{$udom}{'defaults'}) eq 'HASH') {
                    493:                                                         %codedefaults = %{$gotcodedefaults{$udom}{'defaults'}};
                    494:                                                     }
                    495:                                                     if (ref($gotcodedefaults{$udom}{'order'}) eq 'ARRAY') {
                    496:                                                         @code_order = @{$gotcodedefaults{$udom}{'order'}};
                    497:                                                     }
                    498:                                                 } else {
                    499:                                                     &Apache::lonnet::auto_instcode_defaults($udom,
                    500:                                                                                             \%codedefaults,
                    501:                                                                                             \@code_order);
                    502:                                                     $gotcodedefaults{$udom}{'defaults'} = \%codedefaults;
                    503:                                                     $gotcodedefaults{$udom}{'order'} = \@code_order;
                    504:                                                 }
                    505:                                                 if (@code_order > 0) {
                    506:                                                     if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                    507:                                                                                                 $cloner,$clonefromcode,$reqinstcode)) {
                    508:                                                         $canclone = 1;
                    509:                                                         last;
                    510:                                                     }
                    511:                                                 }
                    512:                                             }
                    513:                                         }
                    514:                                     }
                    515:                                 }
                    516:                             }
                    517:                         }
1.4       droeschl  518:                     } elsif (defined($cloneruname)) {
                    519:                         if ($cc_clone{$unesc_key}) {
                    520:                             $canclone = 1;
                    521:                             $items->{'cloners'} = $cloneruname.':'.$clonerudom;
                    522:                             $valchange = 1;
                    523:                         }
                    524:                         unless ($canclone) {
                    525:                             if ($items->{'owner'} =~ /:/) {
                    526:                                 if ($items->{'owner'} eq $cloner) {
                    527:                                     $canclone = 1;
                    528:                                 }
                    529:                             } elsif ($cloner eq $items->{'owner'}.':'.$udom) {
                    530:                                 $canclone = 1;
                    531:                             }
                    532:                             if ($canclone) {
                    533:                                 $items->{'cloners'} = $cloneruname.':'.$clonerudom;
                    534:                                 $valchange = 1;
                    535:                             }
                    536:                         }
                    537:                     }
1.7       raeburn   538:                     unless (($canclone) || ($items->{'cloners'})) {
                    539:                         my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
                    540:                         if ($domdefs{'canclone'}) {
                    541:                             unless ($domdefs{'canclone'} eq 'none') {
                    542:                                 if ($domdefs{'canclone'} eq 'domain') {
                    543:                                     if ($clonerudom eq $udom) {
                    544:                                         $canclone = 1;
                    545:                                     }
                    546:                                 } elsif (($clonefromcode) && ($reqinstcode) &&
                    547:                                          ($udom eq $reqcrsdom)) {
                    548:                                     if (&Apache::lonnet::default_instcode_cloning($udom,$domdefs{'canclone'},
                    549:                                                                                   $clonefromcode,$reqinstcode)) {
                    550:                                         $canclone = 1;
                    551:                                     }
                    552:                                 }
                    553:                             }
                    554:                         }
                    555:                     }
1.4       droeschl  556:                 }
                    557:                 if ($unpack || !$rtn_as_hash) {
                    558:                     $unesc_val{'descr'} = $items->{'description'};
                    559:                     $unesc_val{'inst_code'} = $items->{'inst_code'};
                    560:                     $unesc_val{'owner'} = $items->{'owner'};
                    561:                     $unesc_val{'type'} = $items->{'type'};
                    562:                     $unesc_val{'cloners'} = $items->{'cloners'};
                    563:                     $unesc_val{'created'} = $items->{'created'};
                    564:                     $unesc_val{'context'} = $items->{'context'};
                    565:                 }
                    566:                 $selfenroll_types = $items->{'selfenroll_types'};
                    567:                 $selfenroll_end = $items->{'selfenroll_end_date'};
                    568:                 $created = $items->{'created'};
                    569:                 $context = $items->{'context'};
                    570:                 if ($selfenrollonly) {
                    571:                     next if (!$selfenroll_types);
                    572:                     if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) {
                    573:                         next;
                    574:                     }
                    575:                 }
                    576:                 if ($creationcontext ne '.') {
                    577:                     next if (($context ne '') && ($context ne $creationcontext));  
                    578:                 }
                    579:                 if ($createdbefore > 0) {
                    580:                     next if (($created eq '') || ($created > $createdbefore));   
                    581:                 }
                    582:                 if ($createdafter > 0) {
                    583:                     next if (($created eq '') || ($created <= $createdafter)); 
                    584:                 }
                    585:                 if ($catfilter ne '') {
                    586:                     next if ($items->{'categories'} eq '');
                    587:                     my @categories = split('&',$items->{'categories'}); 
                    588:                     next if (@categories == 0);
                    589:                     my @subcats = split('&',$catfilter);
                    590:                     my $matchcat = 0;
                    591:                     foreach my $cat (@categories) {
                    592:                         if (grep(/^\Q$cat\E$/,@subcats)) {
                    593:                             $matchcat = 1;
                    594:                             last;
                    595:                         }
                    596:                     }
                    597:                     next if (!$matchcat);
                    598:                 }
                    599:                 if ($caller eq 'coursecatalog') {
                    600:                     if ($items->{'hidefromcat'} eq 'yes') {
                    601:                         next if !$showhidden;
                    602:                     }
                    603:                 }
1.6       raeburn   604:                 if ($hasuniquecode ne '.') {
                    605:                     next unless ($items->{'uniquecode'});
                    606:                 }
1.4       droeschl  607:             } else {
                    608:                 next if ($catfilter ne '');
                    609:                 next if ($selfenrollonly);
                    610:                 next if ($createdbefore || $createdafter);
                    611:                 next if ($creationcontext ne '.');
                    612:                 if ((defined($clonerudom)) && (defined($cloneruname)))  {
                    613:                     if ($cc_clone{$unesc_key}) {
                    614:                         $canclone = 1;
                    615:                         $val{'cloners'} = &escape($cloneruname.':'.$clonerudom);
                    616:                     }
                    617:                 }
                    618:                 $is_hash =  0;
                    619:                 my @courseitems = split(/:/,$value);
                    620:                 $lasttime = pop(@courseitems);
                    621:                 if ($hashref->{$lasttime_key} eq '') {
                    622:                     next if ($lasttime<$since);
                    623:                 }
                    624: 	        ($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems;
                    625:             }
                    626:             if ($cloneonly) {
                    627:                next unless ($canclone);
                    628:             }
                    629:             my $match = 1;
                    630: 	    if ($description ne '.') {
                    631:                 if (!$is_hash) {
                    632:                     $unesc_val{'descr'} = &unescape($val{'descr'});
                    633:                 }
                    634:                 if (eval{$unesc_val{'descr'} !~ /\Q$description\E/i}) {
                    635:                     $match = 0;
                    636:                 }
                    637:             }
                    638:             if ($instcodefilter ne '.') {
                    639:                 if (!$is_hash) {
                    640:                     $unesc_val{'inst_code'} = &unescape($val{'inst_code'});
                    641:                 }
                    642:                 if ($regexp_ok == 1) {
                    643:                     if (eval{$unesc_val{'inst_code'} !~ /$instcodefilter/}) {
                    644:                         $match = 0;
                    645:                     }
                    646:                 } elsif ($regexp_ok == -1) {
                    647:                     if (eval{$unesc_val{'inst_code'} =~ /$instcodefilter/}) {
                    648:                         $match = 0;
                    649:                     }
                    650:                 } else {
                    651:                     if (eval{$unesc_val{'inst_code'} !~ /\Q$instcodefilter\E/i}) {
                    652:                         $match = 0;
                    653:                     }
                    654:                 }
                    655: 	    }
                    656:             if ($ownerfilter ne '.') {
                    657:                 if (!$is_hash) {
                    658:                     $unesc_val{'owner'} = &unescape($val{'owner'});
                    659:                 }
                    660:                 if (($ownerunamefilter ne '') && ($ownerdomfilter ne '')) {
                    661:                     if ($unesc_val{'owner'} =~ /:/) {
                    662:                         if (eval{$unesc_val{'owner'} !~ 
                    663:                              /\Q$ownerunamefilter\E:\Q$ownerdomfilter\E$/i}) {
                    664:                             $match = 0;
                    665:                         } 
                    666:                     } else {
                    667:                         if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E/i}) {
                    668:                             $match = 0;
                    669:                         }
                    670:                     }
                    671:                 } elsif ($ownerunamefilter ne '') {
                    672:                     if ($unesc_val{'owner'} =~ /:/) {
                    673:                         if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E:[^:]+$/i}) {
                    674:                              $match = 0;
                    675:                         }
                    676:                     } else {
                    677:                         if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E/i}) {
                    678:                             $match = 0;
                    679:                         }
                    680:                     }
                    681:                 } elsif ($ownerdomfilter ne '') {
                    682:                     if ($unesc_val{'owner'} =~ /:/) {
                    683:                         if (eval{$unesc_val{'owner'} !~ /^[^:]+:\Q$ownerdomfilter\E/}) {
                    684:                              $match = 0;
                    685:                         }
                    686:                     } else {
                    687:                         if ($ownerdomfilter ne $udom) {
                    688:                             $match = 0;
                    689:                         }
                    690:                     }
                    691:                 }
                    692:             }
                    693:             if ($coursefilter ne '.') {
                    694:                 if (eval{$unesc_key !~ /^$udom(_)\Q$coursefilter\E$/}) {
                    695:                     $match = 0;
                    696:                 }
                    697:             }
                    698:             if ($typefilter ne '.') {
                    699:                 if (!$is_hash) {
                    700:                     $unesc_val{'type'} = &unescape($val{'type'});
                    701:                 }
                    702:                 if ($unesc_val{'type'} eq '') {
                    703:                     if ($typefilter ne 'Course') {
                    704:                         $match = 0;
                    705:                     }
                    706:                 } else {
                    707:                     if (eval{$unesc_val{'type'} !~ /^\Q$typefilter\E$/}) {
                    708:                         $match = 0;
                    709:                     }
                    710:                 }
                    711:             }
                    712:             if ($match == 1) {
                    713:                 if ($rtn_as_hash) {
                    714:                     if ($is_hash) {
                    715:                         if ($valchange) {
                    716:                             my $newvalue = &Apache::lonnet::freeze_escape($items);
                    717:                             $qresult.=$key.'='.$newvalue.'&';
                    718:                         } else {
                    719:                             $qresult.=$key.'='.$value.'&';
                    720:                         }
                    721:                     } else {
                    722:                         my %rtnhash = ( 'description' => &unescape($val{'descr'}),
                    723:                                         'inst_code' => &unescape($val{'inst_code'}),
                    724:                                         'owner'     => &unescape($val{'owner'}),
                    725:                                         'type'      => &unescape($val{'type'}),
                    726:                                         'cloners'   => &unescape($val{'cloners'}),
                    727:                                       );
                    728:                         my $items = &Apache::lonnet::freeze_escape(\%rtnhash);
                    729:                         $qresult.=$key.'='.$items.'&';
                    730:                     }
                    731:                 } else {
                    732:                     if ($is_hash) {
                    733:                         $qresult .= $key.'='.&escape($unesc_val{'descr'}).':'.
                    734:                                     &escape($unesc_val{'inst_code'}).':'.
                    735:                                     &escape($unesc_val{'owner'}).'&';
                    736:                     } else {
                    737:                         $qresult .= $key.'='.$val{'descr'}.':'.$val{'inst_code'}.
                    738:                                     ':'.$val{'owner'}.'&';
                    739:                     }
                    740:                 }
                    741:             }
                    742: 	}
                    743:     &untie_domain_hash($hashref) or 
                    744:         return "error: ".($!+0)." untie(GDBM) Failed while attempting courseiddump";
                    745: 
                    746:     chop($qresult);
                    747:     return $qresult;
                    748: }
                    749: 
                    750: sub dump_profile_database {
                    751:     my ($tail) = @_;
                    752: 
                    753:     my ($udom,$uname,$namespace) = split(/:/,$tail);
                    754: 
                    755:     my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER()) or
                    756:         return "error: ".($!+0)." tie(GDBM) Failed while attempting currentdump";
                    757: 
                    758: 	# Structure of %data:
                    759: 	# $data{$symb}->{$parameter}=$value;
                    760: 	# $data{$symb}->{'v.'.$parameter}=$version;
                    761: 	# since $parameter will be unescaped, we do not
                    762:  	# have to worry about silly parameter names...
                    763: 	
                    764:         my $qresult='';
                    765: 	my %data = ();                     # A hash of anonymous hashes..
                    766: 	while (my ($key,$value) = each(%$hashref)) {
                    767: 	    my ($v,$symb,$param) = split(/:/,$key);
                    768: 	    next if ($v eq 'version' || $symb eq 'keys');
                    769: 	    next if (exists($data{$symb}) && 
                    770: 		     exists($data{$symb}->{$param}) &&
                    771: 		     $data{$symb}->{'v.'.$param} > $v);
                    772: 	    $data{$symb}->{$param}=$value;
                    773: 	    $data{$symb}->{'v.'.$param}=$v;
                    774: 	}
                    775: 
                    776:     &untie_user_hash($hashref) or
                    777:         return "error: ".($!+0)." untie(GDBM) Failed while attempting currentdump";
                    778: 
                    779:     while (my ($symb,$param_hash) = each(%data)) {
                    780:     while(my ($param,$value) = each (%$param_hash)){
                    781:         next if ($param =~ /^v\./);       # Ignore versions...
                    782:         #
                    783:         #   Just dump the symb=value pairs separated by &
                    784:         #
                    785:         $qresult.=$symb.':'.$param.'='.$value.'&';
                    786:     }
                    787:     }
1.2       droeschl  788: 
1.4       droeschl  789:     chop($qresult);
                    790:     return $qresult;
                    791: }
1.2       droeschl  792: 
1.11      raeburn   793: sub is_course {
                    794:     my ($cdom,$cnum) = @_;
                    795: 
                    796:     return unless (($cdom =~ /^$LONCAPA::match_domain$/) &&
                    797:                    ($cnum =~ /^$LONCAPA::match_courseid$/));
                    798:     my $hashid = $cdom.':'.$cnum;
                    799:     my ($iscourse,$cached) =
                    800:         &Apache::lonnet::is_cached_new('iscourse',$hashid);
                    801:     unless (defined($cached)) {
                    802:         my $hashref =
                    803:             &tie_domain_hash($cdom, "nohist_courseids", &GDBM_WRCREAT());
                    804:         if (ref($hashref) eq 'HASH') {
                    805:             my $esc_key = &escape($cdom.'_'.$cnum);
                    806:             if (exists($hashref->{$esc_key})) {
                    807:                 $iscourse = 1;
                    808:             } else {
                    809:                 $iscourse = 0;
                    810:             }
                    811:             &Apache::lonnet::do_cache_new('iscourse',$hashid,$iscourse,3600);
                    812:             unless (&untie_domain_hash($hashref)) {
1.17      raeburn   813:                 &Apache::lonnet::logthis("Failed to untie tied hash for nohist_courseids.db for $cdom");
1.11      raeburn   814:             }
                    815:         } else {
1.17      raeburn   816:             &Apache::lonnet::logthis("Failed to tie hash for nohist_courseids.db for $cdom");
1.11      raeburn   817:         }
                    818:     }
                    819:     return $iscourse;
                    820: }
                    821: 
1.9       raeburn   822: sub server_certs {
1.12      raeburn   823:     my ($perlvar,$lonhost,$hostname) = @_;
1.9       raeburn   824:     my %pemfiles = (
                    825:                      key      => 'lonnetPrivateKey',
                    826:                      host     => 'lonnetCertificate',
                    827:                      hostname => 'lonnetHostnameCertificate',
                    828:                      ca       => 'lonnetCertificateAuthority',
1.15      raeburn   829:                      crl      => 'lonnetCertRevocationList',
1.9       raeburn   830:                    );
1.15      raeburn   831:     my (%md5hash,%expected_cn,%expired,%revoked,%wrongcn,%info,$crlfile,$cafile,
                    832:         %rvkcerts,$numrvk);
1.14      raeburn   833:     %info = (
                    834:                 key => {},
                    835:                 ca  => {},
                    836:                 host => {},
                    837:                 hostname => {},
1.15      raeburn   838:                 crl => {},
                    839:             );
                    840:     my @ordered = ('crl','key','ca','host','hostname');
1.9       raeburn   841:     if (ref($perlvar) eq 'HASH') {
1.13      raeburn   842:         $expected_cn{'host'} = $Apache::lonnet::serverhomeIDs{$hostname};
1.12      raeburn   843:         $expected_cn{'hostname'} = 'internal-'.$hostname;
1.9       raeburn   844:         my $certsdir = $perlvar->{'lonCertificateDirectory'};
                    845:         if (-d $certsdir) {
1.15      raeburn   846:             $crlfile = $certsdir.'/'.$perlvar->{$pemfiles{'crl'}};
                    847:             $cafile = $certsdir.'/'.$perlvar->{$pemfiles{'ca'}};
                    848:             foreach my $key (@ordered) {
1.9       raeburn   849:                 if ($perlvar->{$pemfiles{$key}}) {
                    850:                     my $file = $certsdir.'/'.$perlvar->{$pemfiles{$key}};
                    851:                     if (-e $file) {
1.15      raeburn   852:                         if ($key eq 'crl') {
                    853:                              if ((-e $crlfile) && (-e $cafile)) {
                    854:                                  if (open(PIPE,"openssl crl -in $crlfile -inform pem -CAfile $cafile -noout 2>&1 |")) {
                    855:                                      my $crlstatus = <PIPE>;
                    856:                                      close(PIPE);
                    857:                                      chomp($crlstatus);
                    858:                                      if ($crlstatus =~ /OK/) {
                    859:                                          $info{$key}{'status'} = 'ok';
                    860:                                          $info{$key}{'details'} = 'CRL valid for CA';
                    861:                                      }
                    862:                                  }
                    863:                              }
                    864:                              if (open(my $fh,'<',$crlfile)) {
                    865:                                  my $pem_crl = '';
                    866:                                  while (my $line=<$fh>) {
                    867:                                      chomp($line);
                    868:                                      next if ($line eq '-----BEGIN X509 CRL-----');
                    869:                                      next if ($line eq '-----END X509 CRL-----');
                    870:                                      $pem_crl .= $line;
                    871:                                  }
                    872:                                  close($fh);
                    873:                                  my $der_crl = MIME::Base64::decode_base64($pem_crl);
                    874:                                  if ($der_crl ne '') {
                    875:                                      my $decoded = Crypt::X509::CRL->new( crl => $der_crl );
                    876:                                      if ($decoded->error) {
                    877:                                          $info{$key}{'status'} = 'error';
                    878:                                      } elsif (ref($decoded)) {
                    879:                                          $info{$key}{'start'} = $decoded->this_update;
                    880:                                          $info{$key}{'end'} = $decoded->next_update;
                    881:                                          $info{$key}{'alg'} = $decoded->SigEncAlg.' '.$decoded->SigHashAlg;
                    882:                                          $info{$key}{'cn'} = $decoded->issuer_cn;
                    883:                                          $info{$key}{'email'} = $decoded->issuer_email;
                    884:                                          $info{$key}{'size'} = $decoded->signature_length;
                    885:                                          my $rlref = $decoded->revocation_list;
                    886:                                          if (ref($rlref) eq 'HASH') {
                    887:                                              foreach my $key (keys(%{$rlref})) {
                    888:                                                  my $hkey = sprintf("%X",$key);
                    889:                                                  $rvkcerts{$hkey} = 1;
                    890:                                              }
                    891:                                              $numrvk = scalar(keys(%{$rlref}));
                    892:                                              if ($numrvk) {
                    893:                                                  $info{$key}{'details'} .= " ($numrvk revoked)"; 
                    894:                                              }
                    895:                                          }
                    896:                                      }
                    897:                                  }
                    898:                             }
                    899:                         } elsif ($key eq 'key') {
1.9       raeburn   900:                             if (open(PIPE,"openssl rsa -noout -in $file -check |")) {
                    901:                                 my $check = <PIPE>;
                    902:                                 close(PIPE);
                    903:                                 chomp($check);
                    904:                                 $info{$key}{'status'} = $check;
                    905:                             }
                    906:                             if (open(PIPE,"openssl rsa -noout -modulus -in $file | openssl md5 |")) {
                    907:                                 $md5hash{$key} = <PIPE>;
                    908:                                 close(PIPE);
1.12      raeburn   909:                                 chomp($md5hash{$key});
1.9       raeburn   910:                             }
                    911:                         } else {
                    912:                             if ($key eq 'ca') {
                    913:                                 if (open(PIPE,"openssl verify -CAfile $file $file |")) {
                    914:                                     my $check = <PIPE>;
                    915:                                     close(PIPE);
                    916:                                     chomp($check);
                    917:                                     if ($check eq "$file: OK") {
                    918:                                         $info{$key}{'status'} = 'ok';
                    919:                                     } else {
                    920:                                         $check =~ s/^\Q$file\E\:?\s*//;
                    921:                                         $info{$key}{'status'} = $check;
                    922:                                     }
                    923:                                 }
                    924:                             } else {
                    925:                                 if (open(PIPE,"openssl x509 -noout -modulus -in $file | openssl md5 |")) {
                    926:                                     $md5hash{$key} = <PIPE>;
                    927:                                     close(PIPE);
1.12      raeburn   928:                                     chomp($md5hash{$key});
1.9       raeburn   929:                                 }
                    930:                             }
                    931:                             my $x509 = Crypt::OpenSSL::X509->new_from_file($file);
                    932:                             my @items = split(/,\s+/,$x509->subject());
                    933:                             foreach my $item (@items) {
                    934:                                 my ($name,$value) = split(/=/,$item);
                    935:                                 if ($name eq 'CN') {
                    936:                                     $info{$key}{'cn'} = $value;
                    937:                                 }
                    938:                             }
                    939:                             $info{$key}{'start'} = $x509->notBefore();
                    940:                             $info{$key}{'end'} = $x509->notAfter();
                    941:                             $info{$key}{'alg'} = $x509->sig_alg_name();
                    942:                             $info{$key}{'size'} = $x509->bit_length();
                    943:                             $info{$key}{'email'} = $x509->email();
1.15      raeburn   944:                             $info{$key}{'serial'} = uc($x509->serial());
1.14      raeburn   945:                             $info{$key}{'issuerhash'} = $x509->issuer_hash();
1.12      raeburn   946:                             if ($x509->checkend(0)) {
                    947:                                 $expired{$key} = 1;
                    948:                             }
                    949:                             if (($key eq 'host') || ($key eq 'hostname')) {
                    950:                                 if ($info{$key}{'cn'} ne $expected_cn{$key}) {
                    951:                                     $wrongcn{$key} = 1;
                    952:                                 }
1.15      raeburn   953:                                 if (($numrvk) && ($info{$key}{'serial'})) {
                    954:                                     if ($rvkcerts{$info{$key}{'serial'}}) {
                    955:                                         $revoked{$key} = 1;
1.12      raeburn   956:                                     }
                    957:                                 }
                    958:                             }
                    959:                         }
                    960:                     }
                    961:                     if (($key eq 'host') || ($key eq 'hostname')) {
                    962:                         my $csrfile = $file;
                    963:                         $csrfile =~ s/\.pem$/.csr/;
                    964:                         if (-e $csrfile) {
                    965:                             if (open(PIPE,"openssl req -noout -modulus -in $csrfile |openssl md5 |")) {
                    966:                                 my $csrhash = <PIPE>;
                    967:                                 close(PIPE);
                    968:                                 chomp($csrhash);
                    969:                                 if ((!-e $file) || ($csrhash ne $md5hash{$key}) || ($expired{$key}) ||
                    970:                                     ($wrongcn{$key}) || ($revoked{$key})) {
                    971:                                     Crypt::PKCS10->setAPIversion(1);
                    972:                                     my $decoded = Crypt::PKCS10->new( $csrfile,(PEMonly => 1, readFile => 1));
                    973:                                     if (ref($decoded)) {
                    974:                                         if ($decoded->commonName() eq $expected_cn{$key}) {
                    975:                                             $info{$key.'-csr'}{'cn'} = $decoded->commonName();
                    976:                                             $info{$key.'-csr'}{'alg'} = $decoded->pkAlgorithm();
                    977:                                             $info{$key.'-csr'}{'email'} = $decoded->emailAddress();
                    978:                                             my $params = $decoded->subjectPublicKeyParams();
                    979:                                             if (ref($params) eq 'HASH') {
                    980:                                                 $info{$key.'-csr'}{'size'} = $params->{keylen};
                    981:                                             }
                    982:                                             $md5hash{$key.'-csr'} = $csrhash;
                    983:                                         }
                    984:                                     }
                    985:                                 }
                    986:                             }
1.9       raeburn   987:                         }
                    988:                     }
                    989:                 }
                    990:             }
                    991:         }
                    992:     }
                    993:     foreach my $key ('host','hostname') {
                    994:         if ($md5hash{$key}) {
                    995:             if ($md5hash{$key} eq $md5hash{'key'}) {
1.12      raeburn   996:                 if ($revoked{$key}) {
                    997:                     $info{$key}{'status'} = 'revoked';
                    998:                 } elsif ($expired{$key}) {
                    999:                     $info{$key}{'status'} = 'expired';
                   1000:                 } elsif ($wrongcn{$key}) {
                   1001:                     $info{$key}{'status'} = 'wrongcn';
1.14      raeburn  1002:                 } elsif ((exists($info{'ca'}{'issuerhash'})) &&
                   1003:                          ($info{'ca'}{'issuerhash'} ne $info{$key}{'issuerhash'})) {
                   1004:                     $info{$key}{'status'} = 'mismatch';
1.12      raeburn  1005:                 } else {
                   1006:                     $info{$key}{'status'} = 'ok';
                   1007:                 }
1.10      raeburn  1008:             } elsif ($info{'key'}{'status'} =~ /ok/) {
                   1009:                 $info{$key}{'status'} = 'otherkey';
                   1010:             } else {
                   1011:                 $info{$key}{'status'} = 'nokey';
1.9       raeburn  1012:             }
                   1013:         }
1.12      raeburn  1014:         if ($md5hash{$key.'-csr'}) {
                   1015:             if ($md5hash{$key.'-csr'} eq $md5hash{'key'}) {
                   1016:                 $info{$key.'-csr'}{'status'} = 'ok';
                   1017:             } elsif ($info{'key'}{'status'} =~ /ok/) {
                   1018:                 $info{$key.'-csr'}{'status'} = 'otherkey';
                   1019:             } else {
                   1020:                 $info{$key.'-csr'}{'status'} = 'nokey';
                   1021:             }
                   1022:         }
1.9       raeburn  1023:     }
                   1024:     my $result;
                   1025:     foreach my $key (keys(%info)) {
                   1026:         $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($info{$key}).'&';
                   1027:     }
                   1028:     $result =~ s/\&$//;
                   1029:     return $result;
                   1030: }
1.2       droeschl 1031: 
1.16      raeburn  1032: sub get_dom {
                   1033:     my ($userinput) = @_;
                   1034:     my ($cmd,$udom,$namespace,$what) =split(/:/,$userinput,4); 
                   1035:     my $hashref = &tie_domain_hash($udom,$namespace,&GDBM_READER()) or
                   1036:         return "error: ".($!+0)." tie(GDBM) Failed while attempting $cmd";
                   1037:     my $qresult='';
                   1038:     if (ref($hashref)) {
                   1039:         chomp($what);
                   1040:         my @queries=split(/\&/,$what);
                   1041:         for (my $i=0;$i<=$#queries;$i++) {
                   1042:             $qresult.="$hashref->{$queries[$i]}&";
                   1043:         }
                   1044:         $qresult=~s/\&$//;
                   1045:     }
                   1046:     &untie_user_hash($hashref) or
                   1047:         return "error: ".($!+0)." untie(GDBM) Failed while attempting $cmd";
                   1048:     return $qresult;
                   1049: }
                   1050: 
1.19      raeburn  1051: sub store_dom {
                   1052:     my ($userinput) = @_;
                   1053:     my ($cmd,$dom,$namespace,$rid,$what) =split(/:/,$userinput);
                   1054:     my $hashref  = &tie_domain_hash($dom,$namespace,&GDBM_WRCREAT(),"S","$rid:$what") or
                   1055:         return "error: ".($!+0)." tie(GDBM) Failed while attempting $cmd";
                   1056:     $hashref->{"version:$rid"}++;
                   1057:     my $version=$hashref->{"version:$rid"};
                   1058:     my $allkeys='';
                   1059:     my @pairs=split(/\&/,$what);
                   1060:     foreach my $pair (@pairs) {
                   1061:         my ($key,$value)=split(/=/,$pair);
                   1062:         $allkeys.=$key.':';
                   1063:         $hashref->{"$version:$rid:$key"}=$value;
                   1064:     }
                   1065:     my $now = time;
                   1066:     $hashref->{"$version:$rid:timestamp"}=$now;
                   1067:     $allkeys.='timestamp';
                   1068:     $hashref->{"$version:keys:$rid"}=$allkeys;
                   1069:     &untie_user_hash($hashref) or
1.20      raeburn  1070:         return "error: ".($!+0)." untie(GDBM) Failed while attempting $cmd";
1.19      raeburn  1071:     return 'ok';
                   1072: }
                   1073: 
                   1074: sub restore_dom {
                   1075:     my ($userinput) = @_;
                   1076:     my ($cmd,$dom,$namespace,$rid) = split(/:/,$userinput);
                   1077:     my $hashref = &tie_domain_hash($dom,$namespace,&GDBM_READER()) or
                   1078:         return "error: ".($!+0)." tie(GDBM) Failed while attempting $cmd";
                   1079:     my $qresult='';
                   1080:     if (ref($hashref)) {
                   1081:         chomp($rid);
                   1082:         my $version=$hashref->{"version:$rid"};
                   1083:         $qresult.="version=$version&";
                   1084:         my $scope;
                   1085:         for ($scope=1;$scope<=$version;$scope++) {
                   1086:             my $vkeys=$hashref->{"$scope:keys:$rid"};
                   1087:             my @keys=split(/:/,$vkeys);
                   1088:             my $key;
                   1089:             $qresult.="$scope:keys=$vkeys&";
                   1090:             foreach $key (@keys) {
                   1091:                 $qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&";
                   1092:             }
                   1093:         }
                   1094:         $qresult=~s/\&$//;
                   1095:     }
                   1096:     &untie_user_hash($hashref) or
                   1097:         return "error: ".($!+0)." untie(GDBM) Failed while attempting $cmd";
                   1098:     return $qresult;
                   1099: }
                   1100: 
1.18      raeburn  1101: sub crslti_itemid {
                   1102:     my ($cdom,$cnum,$url,$method,$params,$loncaparev) = @_;
                   1103:     unless (ref($params) eq 'HASH') {
                   1104:         return;
                   1105:     }
                   1106:     if (($cdom eq '') || ($cnum eq '')) {
                   1107:         return;
                   1108:     }
                   1109:     my ($itemid,$consumer_key,$secret);
                   1110: 
                   1111:     if (exists($params->{'oauth_callback'})) {
                   1112:         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;
                   1113:     } else {
                   1114:         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0;
                   1115:     }
                   1116: 
                   1117:     my $consumer_key = $params->{'oauth_consumer_key'};
                   1118:     return if ($consumer_key eq '');
                   1119: 
                   1120:     my (%crslti,%crslti_by_key);
                   1121:     my $hashid=$cdom.'_'.$cnum;
                   1122:     my ($result,$cached)=&Apache::lonnet::is_cached_new('courseltienc',$hashid);
                   1123:     if (defined($cached)) {
                   1124:         if (ref($result) eq 'HASH') {
                   1125:             %crslti = %{$result};
                   1126:         }
                   1127:     } else {
                   1128:         my $reply = &dump_with_regexp(join(":",($cdom,$cnum,'nohist_ltienc','','')),$loncaparev);
                   1129:         %crslti = %{&Apache::lonnet::unserialize($reply)};
                   1130:         my $cachetime = 24*60*60;
                   1131:         &Apache::lonnet::do_cache_new('courseltienc',$hashid,\%crslti,$cachetime);
                   1132:     }
                   1133: 
                   1134:     return if (!keys(%crslti));
                   1135: 
                   1136:     foreach my $id (keys(%crslti)) {
                   1137:         if (ref($crslti{$id}) eq 'HASH') {
                   1138:             my $key = $crslti{$id}{'key'};
                   1139:             if (($key ne '') && ($crslti{$id}{'secret'} ne '')) {
                   1140:                 push(@{$crslti_by_key{$key}},$id);
                   1141:             }
                   1142:         }
                   1143:     }
                   1144: 
                   1145:     return if (!keys(%crslti_by_key));
                   1146: 
1.20      raeburn  1147:     my %courselti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider');
                   1148: 
1.18      raeburn  1149:     if (ref($crslti_by_key{$consumer_key}) eq 'ARRAY') {
                   1150:         foreach my $id (@{$crslti_by_key{$consumer_key}}) {
                   1151:             my $secret = $crslti{$id}{'secret'};
1.20      raeburn  1152:             if (ref($courselti{$id}) eq 'HASH') {
                   1153:                 if ((exists($courselti{$id}{'cipher'})) &&
                   1154:                     ($courselti{$id}{'cipher'} =~ /^\d+$/)) {
                   1155:                     my $keynum = $courselti{$id}{'cipher'};
                   1156:                     my $privkey = &get_dom("getdom:$cdom:private:$keynum:lti:key");
                   1157:                     if ($privkey ne '') {
                   1158:                         my $cipher = new Crypt::CBC($privkey);
                   1159:                         $secret = $cipher->decrypt_hex($secret);
                   1160:                     }
                   1161:                 }
                   1162:             }
1.18      raeburn  1163:             my $request = Net::OAuth->request('request token')->from_hash($params,
                   1164:                                               request_url => $url,
                   1165:                                               request_method => $method,
                   1166:                                               consumer_secret => $secret,);
                   1167:             if ($request->verify()) {
                   1168:                 $itemid = $id;
                   1169:                 last;
                   1170:             }
                   1171:         }
                   1172:     }
                   1173:     return $itemid;
                   1174: }
                   1175: 
                   1176: sub domlti_itemid {
                   1177:     my ($dom,$context,$url,$method,$params,$loncaparev) = @_;
                   1178:     unless (ref($params) eq 'HASH') {
                   1179:         return;
                   1180:     }
                   1181:     if ($dom eq '') {
                   1182:         return;
                   1183:     }
                   1184:     my ($itemid,$consumer_key,$secret);
                   1185: 
                   1186:     if (exists($params->{'oauth_callback'})) {
                   1187:         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;
                   1188:     } else {
                   1189:         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0;
                   1190:     }
                   1191: 
                   1192:     my $consumer_key = $params->{'oauth_consumer_key'};
                   1193:     return if ($consumer_key eq '');
                   1194: 
1.21      raeburn  1195:     my ($name,$cachename);
                   1196:     if ($context eq 'linkprot') {
                   1197:         $name = $context;
                   1198:     } else {
                   1199:         $name = 'lti';
                   1200:     }
                   1201:     $cachename = $name.'enc';
1.18      raeburn  1202:     my %ltienc;
1.21      raeburn  1203:     my ($encresult,$enccached)=&Apache::lonnet::is_cached_new($cachename,$dom);
1.18      raeburn  1204:     if (defined($enccached)) {
                   1205:         if (ref($encresult) eq 'HASH') {
                   1206:             %ltienc = %{$encresult};
                   1207:         }
                   1208:     } else {
1.21      raeburn  1209:         my $reply = &get_dom("getdom:$dom:encconfig:$name");
1.18      raeburn  1210:         my $ltiencref = &Apache::lonnet::thaw_unescape($reply);
                   1211:         if (ref($ltiencref) eq 'HASH') {
                   1212:             %ltienc = %{$ltiencref};
                   1213:         }
                   1214:         my $cachetime = 24*60*60;
1.21      raeburn  1215:         &Apache::lonnet::do_cache_new($cachename,$dom,\%ltienc,$cachetime);
1.18      raeburn  1216:     }
                   1217: 
                   1218:     return if (!keys(%ltienc));
                   1219: 
                   1220:     my %lti_by_key;
                   1221:     foreach my $id (keys(%ltienc)) {
                   1222:         if (ref($ltienc{$id}) eq 'HASH') {
                   1223:             my $key = $ltienc{$id}{'key'};
                   1224:             if (($key ne '') && ($ltienc{$id}{'secret'} ne '')) {
1.21      raeburn  1225:                 push(@{$lti_by_key{$key}},$id);
1.18      raeburn  1226:             }
                   1227:         }
                   1228:     }
                   1229:     return if (!keys(%lti_by_key));
                   1230: 
1.21      raeburn  1231:     my %lti = &Apache::lonnet::get_domain_lti($dom,$context);
                   1232: 
1.18      raeburn  1233:     if (ref($lti_by_key{$consumer_key}) eq 'ARRAY') {
                   1234:         foreach my $id (@{$lti_by_key{$consumer_key}}) {
                   1235:             my $secret = $ltienc{$id}{'secret'};
1.21      raeburn  1236:             if (ref($lti{$id}) eq 'HASH') {
                   1237:                 if ((exists($lti{$id}{'cipher'})) &&
                   1238:                     ($lti{$id}{'cipher'} =~ /^\d+$/)) {
                   1239:                     my $keynum = $lti{$id}{'cipher'};
                   1240:                     my $privkey = &get_dom("getdom:$dom:private:$keynum:lti:key");
                   1241:                     if ($privkey ne '') {
                   1242:                         my $cipher = new Crypt::CBC($privkey);
                   1243:                         $secret = $cipher->decrypt_hex($secret);
                   1244:                     }
                   1245:                 }
                   1246:             }
1.18      raeburn  1247:             my $request = Net::OAuth->request('request token')->from_hash($params,
                   1248:                                               request_url => $url,
                   1249:                                               request_method => $method,
                   1250:                                               consumer_secret => $secret,);
                   1251:             if ($request->verify()) {
                   1252:                 $itemid = $id;
                   1253:                 last;
                   1254:             }
                   1255:         }
                   1256:     }
                   1257:     return $itemid;
                   1258: }
                   1259: 
1.22    ! raeburn  1260: sub sign_params {
        !          1261:     my ($cdom,$cnum,$crstool,$url,$idx,$keynum,$post,$loncaparev,$paramsref,$inforef) = @_;
        !          1262:     return unless (ref($paramsref) eq 'HASH');
        !          1263:     my ($sigmethod,$type,$callback);
        !          1264:     if (ref($inforef) eq 'HASH') {
        !          1265:         if (exists($inforef->{'method'})) {
        !          1266:             $sigmethod = $inforef->{'method'};
        !          1267:         }
        !          1268:         if (exists($inforef->{'cb'})) {
        !          1269:             $callback = $inforef->{'cb'};
        !          1270:         }
        !          1271:         if (exists($inforef->{'type'})) {
        !          1272:             $type = $inforef->{'type'};
        !          1273:         }
        !          1274:     }
        !          1275:     my ($cachename,$hashid,$key,$secret,%ltitoolsenc);
        !          1276:     if ($crstool) {
        !          1277:         $cachename = 'crsltitoolsenc';
        !          1278:         $hashid = $cdom.'_'.$cnum;
        !          1279:     } else {
        !          1280:         $cachename = 'ltitoolsenc';
        !          1281:         $hashid = $cdom;
        !          1282:     }
        !          1283:     my ($encresult,$enccached)=&Apache::lonnet::is_cached_new($cachename,$hashid);
        !          1284:     if (defined($enccached)) {
        !          1285:         if (ref($encresult) eq 'HASH') {
        !          1286:             %ltitoolsenc = %{$encresult};
        !          1287:         }
        !          1288:     } else {
        !          1289:         if ($crstool) {
        !          1290:             my $reply = &dump_with_regexp(join(":",($cdom,$cnum,'nohist_toolsenc','','')),$loncaparev);
        !          1291:             %ltitoolsenc = %{&Apache::lonnet::unserialize($reply)};
        !          1292:         } else {
        !          1293:             my $reply = &get_dom("getdom:$cdom:encconfig:ltitools");
        !          1294:             my $ltitoolsencref = &Apache::lonnet::thaw_unescape($reply);
        !          1295:             if (ref($ltitoolsencref) eq 'HASH') {
        !          1296:                 %ltitoolsenc = %{$ltitoolsencref};
        !          1297:             }
        !          1298:         }
        !          1299:         my $cachetime = 24*60*60;
        !          1300:         &Apache::lonnet::do_cache_new($cachename,$hashid,\%ltitoolsenc,$cachetime);
        !          1301:     }
        !          1302:     if (!keys(%ltitoolsenc)) {
        !          1303:          return;
        !          1304:     } elsif (exists($ltitoolsenc{$idx})) {
        !          1305:         if (ref($ltitoolsenc{$idx}) eq 'HASH') {
        !          1306:             if (exists($ltitoolsenc{$idx}{'key'})) {
        !          1307:                 $key = $ltitoolsenc{$idx}{'key'};
        !          1308:             }
        !          1309:             if (exists($ltitoolsenc{$idx}{'secret'})) {
        !          1310:                 $secret = $ltitoolsenc{$idx}{'secret'};
        !          1311:                 my $privhost;
        !          1312:                 if ($keynum =~ /^\d+$/) {
        !          1313:                     if ($crstool) {
        !          1314:                         my $primary = &Apache::lonnet::domain($cdom,'primary');
        !          1315:                         my @ids = &Apache::lonnet::current_machine_ids();
        !          1316:                         unless (grep(/^\Q$primary\E$/,@ids)) {
        !          1317:                             $privhost = $primary;
        !          1318:                             my ($result,$plainsecret) = &decrypt_secret($privhost,$secret,$keynum,'ltitools');
        !          1319:                             if ($result eq 'ok') {
        !          1320:                                 $secret = $plainsecret;
        !          1321:                             } else {
        !          1322:                                 undef($secret);
        !          1323:                             }
        !          1324:                         }
        !          1325:                     }
        !          1326:                     unless ($privhost) {
        !          1327:                         my $privkey = &get_dom("getdom:$cdom:private:$keynum:ltitools:key");
        !          1328:                         if (($privkey ne '') && ($secret ne '')) {
        !          1329:                             my $cipher = new Crypt::CBC($privkey);
        !          1330:                             $secret = $cipher->decrypt_hex($secret);
        !          1331:                         } else {
        !          1332:                             undef($secret);
        !          1333:                         }
        !          1334:                     }
        !          1335:                 }
        !          1336:             }
        !          1337:         }
        !          1338:     }
        !          1339:     return if (($key eq '') || ($secret eq ''));
        !          1340:     if ($sigmethod eq '') {
        !          1341:         $sigmethod = 'HMAC-SHA1';
        !          1342:     }
        !          1343:     if ($type eq '') {
        !          1344:         $type = 'request token';
        !          1345:     }
        !          1346:     if ($callback eq '') {
        !          1347:         $callback = 'about:blank',
        !          1348:     }
        !          1349:     srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.
        !          1350:     my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
        !          1351:     my $request = Net::OAuth->request($type)->new(
        !          1352:             consumer_key => $key,
        !          1353:             consumer_secret => $secret,
        !          1354:             request_url => $url,
        !          1355:             request_method => 'POST',
        !          1356:             signature_method => $sigmethod,
        !          1357:             timestamp => time,
        !          1358:             nonce => $nonce,
        !          1359:             callback => $callback,
        !          1360:             extra_params => $paramsref,
        !          1361:             version      => '1.0',
        !          1362:             );
        !          1363:     $request->sign();
        !          1364:     if ($post) {
        !          1365:         return $request->to_post_body();
        !          1366:     } else {
        !          1367:         return $request->to_hash();
        !          1368:     }
        !          1369: }
        !          1370: 
        !          1371: sub decrypt_secret {
        !          1372:     my ($privhost,$secret,$keynum,$type) = @_;
        !          1373:     return;
        !          1374: }
        !          1375: 
1.1       droeschl 1376: 1;
                   1377: 
                   1378: __END__
                   1379: 
                   1380: =head1 NAME
                   1381: 
                   1382: LONCAPA::Lond.pm
                   1383: 
                   1384: =head1 SYNOPSIS
                   1385: 
                   1386: #TODO
                   1387: 
                   1388: =head1 DESCRIPTION
                   1389: 
                   1390: #TODO
                   1391: 
                   1392: =head1 METHODS
                   1393: 
                   1394: =over 4
                   1395: 
1.2       droeschl 1396: =item dump_with_regexp( $tail, $client )
1.1       droeschl 1397: 
                   1398: Dump a profile database with an optional regular expression to match against
                   1399: the keys.  In this dump, no effort is made to separate symb from version
                   1400: information. Presumably the databases that are dumped by this command are of a
                   1401: different structure.  Need to look at this and improve the documentation of
                   1402: both this and the currentdump handler.
                   1403: 
                   1404: $tail a colon separated list containing
                   1405: 
                   1406: =over 
                   1407: 
                   1408: =item domain
                   1409: 
                   1410: =item user 
                   1411: 
                   1412: identifying the user.
                   1413: 
                   1414: =item namespace    
                   1415: 
                   1416: identifying the database.
                   1417: 
                   1418: =item regexp     
                   1419: 
                   1420: optional regular expression that is matched against database keywords to do
                   1421: selective dumps.
                   1422: 
                   1423: =item range       
                   1424: 
                   1425: optional range of entries e.g., 10-20 would return the 10th to 19th items, etc.  
                   1426: 
                   1427: =back
                   1428: 
                   1429: $client is the channel open on the client.
                   1430: 
                   1431: Returns: 1 (Continue processing).
                   1432: 
                   1433: Side effects: response is written to $client.  
                   1434: 
1.5       bisitz   1435: =item dump_course_id_handler
1.4       droeschl 1436: 
                   1437: #TODO copy from lond
                   1438: 
                   1439: =item dump_profile_database
                   1440: 
                   1441: #TODO copy from lond  
1.2       droeschl 1442: 
                   1443: =item releasereqd_check( $cnum, $cdom, $key, $value, $major, $minor, 
                   1444:         $homecourses, $ids )
                   1445: 
                   1446: releasereqd_check() will determine if a LON-CAPA version (defined in the
                   1447: $major,$minor args passed) is not too old to allow use of a role in a 
                   1448: course ($cnum,$cdom args passed), if at least one of the following applies: 
                   1449: (a) the course is a Community, (b) the course's home server is *not* the
                   1450: current server, or (c) cached course information is not stale. 
                   1451: 
                   1452: For the case where none of these apply, the course is added to the 
                   1453: $homecourse hash ref (keys = courseIDs, values = array of a hash of roles).
                   1454: The $homecourse hash ref is for courses for which the current server is the 
                   1455: home server.  LON-CAPA version requirements are checked elsewhere for the
                   1456: items in $homecourse.
                   1457: 
                   1458: 
                   1459: =item check_homecourses( $homecourses, $regexp, $count, $range, $start, $end, 
                   1460:         $major, $minor )
                   1461: 
                   1462: check_homecourses() will retrieve course information for those courses which
                   1463: are keys of the $homecourses hash ref (first arg). The nohist_courseids.db 
                   1464: GDBM file is tied and course information for each course retrieved. Last   
                   1465: visit (lasttime key) is also retrieved for each, and cached values updated  
                   1466: for any courses last visited less than 24 hours ago. Cached values are also
                   1467: updated for any courses included in the $homecourses hash ref.
                   1468: 
                   1469: The reason for the 24 hours constraint is that the cron entry in 
                   1470: /etc/cron.d/loncapa for /home/httpd/perl/refresh_courseids_db.pl causes 
                   1471: cached course information to be updated nightly for courses with activity
                   1472: within the past 24 hours.
                   1473: 
                   1474: Role information for the user (included in a ref to an array of hashes as the
                   1475: value for each key in $homecourses) is appended to the result returned by the
                   1476: routine, which will in turn be appended to the string returned to the client
                   1477: hosting the user's session.
                   1478: 
                   1479: 
                   1480: =item useable_role( $reqdmajor, $reqdminor, $major, $minor )
                   1481: 
                   1482: useable_role() will compare the LON-CAPA version required by a course with 
                   1483: the version available on the client server.  If the client server's version
                   1484: is compatible, 1 will be returned.
                   1485: 
                   1486: 
1.3       droeschl 1487: =item get_courseinfo_hash( $cnum, $cdom, $home )
                   1488: 
                   1489: get_courseinfo_hash() is used to retrieve course information from the db
                   1490: file: nohist_courseids.db for a course for which the current server is *not*
                   1491: the home server.
                   1492: 
                   1493: A hash of a hash will be retrieved. The outer hash contains a single key --
                   1494: courseID -- for the course for which the data are being requested.
                   1495: The contents of the inner hash, for that single item in the outer hash
                   1496: are returned (and cached in memcache for 10 minutes).
                   1497: 
1.16      raeburn  1498: =item get_dom ( $userinput )
1.3       droeschl 1499: 
1.16      raeburn  1500: get_dom() will retrieve domain configuration information from a GDBM file
                   1501: in /home/httpd/lonUsers/$dom on the primary library server in a domain.
                   1502: The single argument passed is the string: $cmd:$udom:$namespace:$what
                   1503: where $cmd is the command historically passed to lond - i.e., getdom
                   1504: or egetdom, $udom is the domain, $namespace is the name of the GDBM file
                   1505: (encconfig or configuration), and $what is a string containing names of 
                   1506: items to retrieve from the db file (each item name is escaped and separated
                   1507: from the next item name with an ampersand). The return value is either:
                   1508: error: followed by an error message, or a string containing the value (escaped)
                   1509: for each item, again separated from the next item with an ampersand.
1.3       droeschl 1510: 
1.1       droeschl 1511: =back
                   1512: 
                   1513: =head1 BUGS
                   1514: 
                   1515: No known bugs at this time.
                   1516: 
                   1517: =head1 SEE ALSO
                   1518: 
                   1519: L<Apache::lonnet>, L<lond>
                   1520: 
                   1521: =cut  

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