--- loncom/lonnet/perl/lonnet.pm 2000/11/27 20:44:04 1.71
+++ loncom/lonnet/perl/lonnet.pm 2001/08/09 19:28:47 1.147
@@ -3,6 +3,9 @@
#
# Functions for use by content handlers:
#
+# metadata_query(sql-query-string,custom-metadata-regex) :
+# returns file handle of where sql and
+# regex results will be stored for query
# plaintext(short) : plain text explanation of short term
# fileembstyle(ext) : embed style in page for file extension
# filedescription(ext) : descriptor text for file extension
@@ -13,7 +16,7 @@
# 1: user needs to choose course
# 2: browse allowed
# definerole(rolename,sys,dom,cou) : define a custom role rolename
-# set priviledges in format of lonTabs/roles.tab for
+# set privileges in format of lonTabs/roles.tab for
# system, domain and course level,
# assignrole(udom,uname,url,role,end,start) : give a role to a user for the
# level given by url. Optional start and end dates
@@ -25,15 +28,39 @@
# revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role
# appenv(hash) : adds hash to session environment
# delenv(varname) : deletes all environment entries starting with varname
-# store(hash) : stores hash permanently for this url
-# cstore(hash) : critical store
-# restore : returns hash for this url
-# eget(namesp,array) : returns hash with keys from array filled in from namesp
-# get(namesp,array) : returns hash with keys from array filled in from namesp
-# del(namesp,array) : deletes keys out of array from namesp
-# put(namesp,hash) : stores hash in namesp
-# cput(namesp,hash) : critical put
-# dump(namesp) : dumps the complete namespace into a hash
+# store(hashref,symb,courseid,udom,uname)
+# : stores hash permanently for this url
+# hashref needs to be given, and should be a \%hashname
+# the remaining args aren't required and if they aren't
+# passed or are '' they will be derived from the ENV
+# cstore(hashref,symb,courseid,udom,uname)
+# : same as store but uses the critical interface to
+# guarentee a store
+# restore(symb,courseid,udom,uname)
+# : returns hash for this symb, all args are optional
+# if they aren't given they will be derived from the
+# current enviroment
+#
+#
+# for the next 6 functions udom and uname are optional
+# if supplied they use udom as the domain and uname
+# as the username for the function (supply a courseid
+# for the uname if you want a course database)
+# if not supplied it uses %ENV and looks at
+# user. attribute for the values
+#
+# eget(namesp,arrayref,udom,uname)
+# : returns hash with keys from array reference filled
+# in from namesp (encrypts the return communication)
+# get(namesp,arrayref,udom,uname)
+# : returns hash with keys from array reference filled
+# in from namesp
+# dump(namesp,udom,uname) : dumps the complete namespace into a hash
+# del(namesp,array,udom,uname) : deletes keys out of array from namesp
+# put(namesp,hash,udom,uname) : stores hash in namesp
+# cput(namesp,hash,udom,uname) : critical put
+#
+#
# ssi(url,hash) : does a complete request cycle on url to localhost, posts
# hash
# coursedescription(id) : returns and caches course description for id
@@ -45,10 +72,11 @@
# EXT(name) : value of a variable
# symblist(map,hash) : Updates symbolic storage links
# symbread([filename]) : returns the data handle (filename optional)
-# rndseed() : returns a random seed
+# rndseed() : returns a random seed
+# receipt() : returns a receipt to be given out to users
# getfile(filename) : returns the contents of filename, or a -1 if it can't
# be found, replicates and subscribes to the file
-# filelocation(dir,file) : returns a farily clean absolute reference to file
+# filelocation(dir,file) : returns a fairly clean absolute reference to file
# from the directory dir
# hreflocation(dir,file) : same as filelocation, but for hrefs
# log(domain,user,home,msg) : write to permanent log for user
@@ -61,6 +89,8 @@
# an array of IDs
# idrget(domain,array): returns hash with IDs for usernames (name=>id,...) for
# an array of names
+# metadata(file,entry): returns the metadata entry for a file. entry='keys'
+# returns a comma separated list of keys
#
# 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,
# 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,
@@ -77,7 +107,22 @@
# 10/04 Guy Albertelli
# 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29,
# 10/30,10/31,
-# 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27 Gerd Kortemeyer
+# 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27,
+# 12/02,12/12,12/13,12/14,12/28,12/29 Gerd Kortemeyer
+# 05/01/01 Guy Albertelli
+# 05/01,06/01,09/01 Gerd Kortemeyer
+# 09/01 Guy Albertelli
+# 09/01,10/01,11/01 Gerd Kortemeyer
+# 02/27/01 Scott Harrison
+# 3/2 Gerd Kortemeyer
+# 3/15,3/19 Scott Harrison
+# 3/19,3/20 Gerd Kortemeyer
+# 3/22,3/27,4/2,4/16,4/17 Scott Harrison
+# 5/26,5/28 Gerd Kortemeyer
+# 5/30 H. K. Ng
+# 6/1 Gerd Kortemeyer
+# July Guy Albertelli
+# 8/4,8/7,8/8,8/9 Gerd Kortemeyer
package Apache::lonnet;
@@ -86,11 +131,12 @@ use Apache::File;
use LWP::UserAgent();
use HTTP::Headers;
use vars
-qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache);
+qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache %packagetab);
use IO::Socket;
use GDBM_File;
use Apache::Constants qw(:common :http);
use HTML::TokeParser;
+use Fcntl qw(:flock);
# --------------------------------------------------------------------- Logging
@@ -173,6 +219,11 @@ sub reconlonc {
sub critical {
my ($cmd,$server)=@_;
+ unless ($hostname{$server}) {
+ &logthis("WARNING:".
+ " Critical message to unknown server ($server)");
+ return 'no_such_host';
+ }
my $answer=reply($cmd,$server);
if ($answer eq 'con_lost') {
my $pingreply=reply('ping',$server);
@@ -231,13 +282,26 @@ sub appenv {
$ENV{$_}=$newenv{$_};
}
} keys %newenv;
+
+ my $lockfh;
+ unless ($lockfh=Apache::File->new("$ENV{'user.environment'}")) {
+ return 'error: '.$!;
+ }
+ unless (flock($lockfh,LOCK_EX)) {
+ &logthis("WARNING: ".
+ 'Could not obtain exclusive lock in appenv: '.$!);
+ $lockfh->close();
+ return 'error: '.$!;
+ }
+
my @oldenv;
{
my $fh;
unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
- return 'error';
+ return 'error: '.$!;
}
@oldenv=<$fh>;
+ $fh->close();
}
for (my $i=0; $i<=$#oldenv; $i++) {
chomp($oldenv[$i]);
@@ -257,7 +321,10 @@ sub appenv {
foreach $newname (keys %newenv) {
print $fh "$newname=$newenv{$newname}\n";
}
+ $fh->close();
}
+
+ $lockfh->close();
return 'ok';
}
# ----------------------------------------------------- Delete from Environment
@@ -276,16 +343,30 @@ sub delenv {
unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
return 'error';
}
+ unless (flock($fh,LOCK_SH)) {
+ &logthis("WARNING: ".
+ 'Could not obtain shared lock in delenv: '.$!);
+ $fh->close();
+ return 'error: '.$!;
+ }
@oldenv=<$fh>;
+ $fh->close();
}
{
my $fh;
unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {
return 'error';
}
+ unless (flock($fh,LOCK_EX)) {
+ &logthis("WARNING: ".
+ 'Could not obtain exclusive lock in delenv: '.$!);
+ $fh->close();
+ return 'error: '.$!;
+ }
map {
unless ($_=~/^$delthis/) { print $fh $_; }
} @oldenv;
+ $fh->close();
}
return 'ok';
}
@@ -380,7 +461,7 @@ sub idget {
$idlist=~tr/A-Z/a-z/;
my $reply=&reply("idget:$udom:".$idlist,$tryserver);
my @answer=();
- if ($reply ne 'con_lost') {
+ if (($reply ne 'con_lost') && ($reply!~/^error\:/)) {
@answer=split(/\&/,$reply);
} ;
my $i;
@@ -578,60 +659,133 @@ sub log {
return critical("log:$dom:$nam:$what",$hom);
}
+# --------------------------------------------- Set Expire Date for Spreadsheet
+
+sub expirespread {
+ my ($uname,$udom,$stype,$usymb)=@_;
+ my $cid=$ENV{'request.course.id'};
+ if ($cid) {
+ my $now=time;
+ my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
+ return &reply('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
+ $ENV{'course.'.$cid.'.num'}.
+ ':nohist_expirationdates:'.
+ &escape($key).'='.$now,
+ $ENV{'course.'.$cid.'.home'})
+ }
+ return 'ok';
+}
+
+# ----------------------------------------------------- Devalidate Spreadsheets
+
+sub devalidate {
+ my $symb=shift;
+ my $cid=$ENV{'request.course.id'};
+ if ($cid) {
+ my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':';
+ my $status=
+ &del('nohist_calculatedsheet',
+ [$key.'studentcalc'],
+ $ENV{'course.'.$cid.'.domain'},
+ $ENV{'course.'.$cid.'.num'})
+ .' '.
+ &del('nohist_calculatedsheets_'.$cid,
+ [$key.'assesscalc:'.$symb]);
+ unless ($status eq 'ok ok') {
+ &logthis('Could not devalidate spreadsheet '.
+ $ENV{'user.name'}.' at '.$ENV{'user.domain'}.' for '.
+ $symb.': '.$status);
+ }
+ }
+}
+
# ----------------------------------------------------------------------- Store
sub store {
- my %storehash=@_;
- my $symb;
- unless ($symb=escape(&symbread())) { return ''; }
- my $namespace;
- unless ($namespace=$ENV{'request.course.id'}) { return ''; }
+ my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
+ my $home='';
+
+ if ($stuname) {
+ $home=&homeserver($stuname,$domain);
+ }
+
+ if (!$symb) { unless ($symb=&symbread()) { return ''; } }
+
+ &devalidate($symb);
+
+ $symb=escape($symb);
+ if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
+ if (!$domain) { $domain=$ENV{'user.domain'}; }
+ if (!$stuname) { $stuname=$ENV{'user.name'}; }
+ if (!$home) { $home=$ENV{'user.home'}; }
my $namevalue='';
map {
- $namevalue.=escape($_).'='.escape($storehash{$_}).'&';
- } keys %storehash;
+ $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
+ } keys %$storehash;
$namevalue=~s/\&$//;
- return reply(
- "store:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb:$namevalue",
- "$ENV{'user.home'}");
+ return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
}
# -------------------------------------------------------------- Critical Store
sub cstore {
- my %storehash=@_;
- my $symb;
- unless ($symb=escape(&symbread())) { return ''; }
- my $namespace;
- unless ($namespace=$ENV{'request.course.id'}) { return ''; }
+ my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
+ my $home='';
+
+ if ($stuname) {
+ $home=&homeserver($stuname,$domain);
+ }
+
+ if (!$symb) { unless ($symb=&symbread()) { return ''; } }
+
+ &devalidate($symb);
+
+ $symb=escape($symb);
+ if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
+ if (!$domain) { $domain=$ENV{'user.domain'}; }
+ if (!$stuname) { $stuname=$ENV{'user.name'}; }
+ if (!$home) { $home=$ENV{'user.home'}; }
+
my $namevalue='';
map {
- $namevalue.=escape($_).'='.escape($storehash{$_}).'&';
- } keys %storehash;
+ $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
+ } keys %$storehash;
$namevalue=~s/\&$//;
- return critical(
- "store:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb:$namevalue",
- "$ENV{'user.home'}");
+ return critical("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
}
# --------------------------------------------------------------------- Restore
sub restore {
- my $symb;
- unless ($symb=escape(&symbread())) { return ''; }
- my $namespace;
- unless ($namespace=$ENV{'request.course.id'}) { return ''; }
- my $answer=reply(
- "restore:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb",
- "$ENV{'user.home'}");
+ my ($symb,$namespace,$domain,$stuname) = @_;
+ my $home='';
+
+ if ($stuname) {
+ $home=&homeserver($stuname,$domain);
+ }
+
+ if (!$symb) {
+ unless ($symb=escape(&symbread())) { return ''; }
+ } else {
+ $symb=&escape($symb);
+ }
+ if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
+ if (!$domain) { $domain=$ENV{'user.domain'}; }
+ if (!$stuname) { $stuname=$ENV{'user.name'}; }
+ if (!$home) { $home=$ENV{'user.home'}; }
+ my $answer=&reply("restore:$domain:$stuname:$namespace:$symb","$home");
+
my %returnhash=();
map {
my ($name,$value)=split(/\=/,$_);
$returnhash{&unescape($name)}=&unescape($value);
} split(/\&/,$answer);
- map {
- $returnhash{$_}=$returnhash{$returnhash{'version'}.':'.$_};
- } split(/\:/,$returnhash{$returnhash{'version'}.':keys'});
+ my $version;
+ for ($version=1;$version<=$returnhash{'version'};$version++) {
+ map {
+ $returnhash{$_}=$returnhash{$version.':'.$_};
+ } split(/\:/,$returnhash{$version.':keys'});
+ }
return %returnhash;
}
@@ -642,23 +796,18 @@ sub coursedescription {
$courseid=~s/^\///;
$courseid=~s/\_/\//g;
my ($cdomain,$cnum)=split(/\//,$courseid);
- my $chome=homeserver($cnum,$cdomain);
+ my $chome=&homeserver($cnum,$cdomain);
if ($chome ne 'no_host') {
- my $rep=reply("dump:$cdomain:$cnum:environment",$chome);
- if ($rep ne 'con_lost') {
- my $normalid=$courseid;
- $normalid=~s/\//\_/g;
+ my %returnhash=&dump('environment',$cdomain,$cnum);
+ if (!exists($returnhash{'con_lost'})) {
+ my $normalid=$cdomain.'_'.$cnum;
my %envhash=();
- my %returnhash=('home' => $chome,
- 'domain' => $cdomain,
- 'num' => $cnum);
- map {
- my ($name,$value)=split(/\=/,$_);
- $name=&unescape($name);
- $value=&unescape($value);
- $returnhash{$name}=$value;
+ $returnhash{'home'}= $chome;
+ $returnhash{'domain'} = $cdomain;
+ $returnhash{'num'} = $cnum;
+ while (my ($name,$value) = each %returnhash) {
$envhash{'course.'.$normalid.'.'.$name}=$value;
- } split(/\&/,$rep);
+ }
$returnhash{'url'}='/res/'.declutter($returnhash{'url'});
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.
$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;
@@ -673,7 +822,7 @@ sub coursedescription {
return ();
}
-# -------------------------------------------------------- Get user priviledges
+# -------------------------------------------------------- Get user privileges
sub rolesinit {
my ($domain,$username,$authhost)=@_;
@@ -743,16 +892,20 @@ sub rolesinit {
}
}
} split(/&/,$rolesdump);
+ my $adv=0;
+ my $author=0;
map {
%thesepriv=();
+ if (($_!~/^st/) && ($_!~/^ta/) && ($_!~/^cm/)) { $adv=1; }
+ if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
map {
if ($_ ne '') {
- my ($priviledge,$restrictions)=split(/&/,$_);
+ my ($privilege,$restrictions)=split(/&/,$_);
if ($restrictions eq '') {
- $thesepriv{$priviledge}='F';
+ $thesepriv{$privilege}='F';
} else {
- if ($thesepriv{$priviledge} ne 'F') {
- $thesepriv{$priviledge}.=$restrictions;
+ if ($thesepriv{$privilege} ne 'F') {
+ $thesepriv{$privilege}.=$restrictions;
}
}
}
@@ -761,6 +914,9 @@ sub rolesinit {
map { $thesestr.=':'.$_.'&'.$thesepriv{$_}; } keys %thesepriv;
$userroles.='user.priv.'.$_.'='.$thesestr."\n";
} keys %allroles;
+ $userroles.='user.adv='.$adv."\n".
+ 'user.author='.$author."\n";
+ $ENV{'user.adv'}=$adv;
}
return $userroles;
}
@@ -768,43 +924,51 @@ sub rolesinit {
# --------------------------------------------------------------- get interface
sub get {
- my ($namespace,@storearr)=@_;
+ my ($namespace,$storearr,$udomain,$uname)=@_;
my $items='';
map {
$items.=escape($_).'&';
- } @storearr;
+ } @$storearr;
$items=~s/\&$//;
- my $rep=reply("get:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
- $ENV{'user.home'});
+ if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+ if (!$uname) { $uname=$ENV{'user.name'}; }
+ my $uhome=&homeserver($uname,$udomain);
+
+ my $rep=&reply("get:$udomain:$uname:$namespace:$items",$uhome);
my @pairs=split(/\&/,$rep);
my %returnhash=();
my $i=0;
map {
$returnhash{$_}=unescape($pairs[$i]);
$i++;
- } @storearr;
+ } @$storearr;
return %returnhash;
}
# --------------------------------------------------------------- del interface
sub del {
- my ($namespace,@storearr)=@_;
+ my ($namespace,$storearr,$udomain,$uname)=@_;
my $items='';
map {
$items.=escape($_).'&';
- } @storearr;
+ } @$storearr;
$items=~s/\&$//;
- return reply("del:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
- $ENV{'user.home'});
+ if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+ if (!$uname) { $uname=$ENV{'user.name'}; }
+ my $uhome=&homeserver($uname,$udomain);
+
+ return &reply("del:$udomain:$uname:$namespace:$items",$uhome);
}
# -------------------------------------------------------------- dump interface
sub dump {
- my $namespace=shift;
- my $rep=reply("dump:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace",
- $ENV{'user.home'});
+ my ($namespace,$udomain,$uname)=@_;
+ if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+ if (!$uname) { $uname=$ENV{'user.name'}; }
+ my $uhome=&homeserver($uname,$udomain);
+ my $rep=reply("dump:$udomain:$uname:$namespace",$uhome);
my @pairs=split(/\&/,$rep);
my %returnhash=();
map {
@@ -817,52 +981,57 @@ sub dump {
# --------------------------------------------------------------- put interface
sub put {
- my ($namespace,%storehash)=@_;
+ my ($namespace,$storehash,$udomain,$uname)=@_;
+ if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+ if (!$uname) { $uname=$ENV{'user.name'}; }
+ my $uhome=&homeserver($uname,$udomain);
my $items='';
map {
- $items.=escape($_).'='.escape($storehash{$_}).'&';
- } keys %storehash;
+ $items.=&escape($_).'='.&escape($$storehash{$_}).'&';
+ } keys %$storehash;
$items=~s/\&$//;
- return reply("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
- $ENV{'user.home'});
+ return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
}
# ------------------------------------------------------ critical put interface
sub cput {
- my ($namespace,%storehash)=@_;
+ my ($namespace,$storehash,$udomain,$uname)=@_;
+ if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+ if (!$uname) { $uname=$ENV{'user.name'}; }
+ my $uhome=&homeserver($uname,$udomain);
my $items='';
map {
- $items.=escape($_).'='.escape($storehash{$_}).'&';
- } keys %storehash;
+ $items.=escape($_).'='.escape($$storehash{$_}).'&';
+ } keys %$storehash;
$items=~s/\&$//;
- return critical
- ("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
- $ENV{'user.home'});
+ return &critical("put:$udomain:$uname:$namespace:$items",$uhome);
}
# -------------------------------------------------------------- eget interface
sub eget {
- my ($namespace,@storearr)=@_;
+ my ($namespace,$storearr,$udomain,$uname)=@_;
my $items='';
map {
$items.=escape($_).'&';
- } @storearr;
+ } @$storearr;
$items=~s/\&$//;
- my $rep=reply("eget:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
- $ENV{'user.home'});
+ if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+ if (!$uname) { $uname=$ENV{'user.name'}; }
+ my $uhome=&homeserver($uname,$udomain);
+ my $rep=&reply("eget:$udomain:$uname:$namespace:$items",$uhome);
my @pairs=split(/\&/,$rep);
my %returnhash=();
my $i=0;
map {
$returnhash{$_}=unescape($pairs[$i]);
$i++;
- } @storearr;
+ } @$storearr;
return %returnhash;
}
-# ------------------------------------------------- Check for a user priviledge
+# ------------------------------------------------- Check for a user privilege
sub allowed {
my ($priv,$uri)=@_;
@@ -894,7 +1063,9 @@ sub allowed {
# Course: uri itself is a course
my $courseuri=$uri;
$courseuri=~s/\_(\d)/\/$1/;
- if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseuri}
+ $courseuri=~s/^([^\/])/\/$1/;
+
+ if ($ENV{'user.priv.'.$ENV{'request.role'}.'.'.$courseuri}
=~/$priv\&([^\:]*)/) {
$thisallowed.=$1;
}
@@ -911,7 +1082,7 @@ sub allowed {
return $thisallowed;
}
#
-# Gathered so far: system, domain and course wide priviledges
+# Gathered so far: system, domain and course wide privileges
#
# Course: See if uri or referer is an individual resource that is part of
# the course
@@ -936,7 +1107,7 @@ sub allowed {
$checkreferer=0;
}
}
-
+
if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) {
my $refuri=$ENV{'HTTP_REFERER'};
$refuri=~s/^http\:\/\/$ENV{'request.host'}//i;
@@ -962,7 +1133,7 @@ sub allowed {
}
#
-# Gathered now: all priviledges that could apply, and condition number
+# Gathered now: all privileges that could apply, and condition number
#
#
# Full or no access?
@@ -994,6 +1165,7 @@ sub allowed {
if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
my $courseid=$2;
my $roleid=$1.'.'.$2;
+ $courseid=~s/^\///;
my $expiretime=600;
if ($ENV{'request.role'} eq $roleid) {
$expiretime=120;
@@ -1131,6 +1303,27 @@ sub definerole {
}
}
+# ---------------- Make a metadata query against the network of library servers
+
+sub metadata_query {
+ my ($query,$custom,$customshow)=@_;
+ # need to put in a library server loop here and return a hash
+ my %rhash;
+ for my $server (keys %libserv) {
+ unless ($custom or $customshow) {
+ my $reply=&reply("querysend:".&escape($query),$server);
+ $rhash{$server}=$reply;
+ }
+ else {
+ my $reply=&reply("querysend:".&escape($query).':'.
+ &escape($custom).':'.&escape($customshow),
+ $server);
+ $rhash{$server}=$reply;
+ }
+ }
+ return \%rhash;
+}
+
# ------------------------------------------------------------------ Plain Text
sub plaintext {
@@ -1147,7 +1340,7 @@ sub fileembstyle {
# ------------------------------------------------------------ Description Text
-sub filedecription {
+sub filedescription {
my $ending=shift;
return $fd{$ending};
}
@@ -1157,29 +1350,201 @@ sub filedecription {
sub assignrole {
my ($udom,$uname,$url,$role,$end,$start)=@_;
my $mrole;
- $url=declutter($url);
if ($role =~ /^cr\//) {
- unless ($url=~/\.course$/) { return 'invalid'; }
- unless (allowed('ccr',$url)) { return 'refused'; }
+ unless (&allowed('ccr',$url)) {
+ &logthis('Refused custom assignrole: '.
+ $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
+ $ENV{'user.name'}.' at '.$ENV{'user.domain'});
+ return 'refused';
+ }
$mrole='cr';
} else {
- unless (($url=~/\.course$/) || ($url=~/\/$/)) { return 'invalid'; }
- unless (allowed('c'+$role)) { return 'refused'; }
+ my $cwosec=$url;
+ $cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;
+ unless (&allowed('c'.$role,$cwosec)) {
+ &logthis('Refused assignrole: '.
+ $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
+ $ENV{'user.name'}.' at '.$ENV{'user.domain'});
+ return 'refused';
+ }
$mrole=$role;
}
my $command="encrypt:rolesput:$ENV{'user.domain'}:$ENV{'user.name'}:".
"$udom:$uname:$url".'_'."$mrole=$role";
- if ($end) { $command.='_$end'; }
+ if ($end) { $command.='_'.$end; }
if ($start) {
if ($end) {
- $command.='_$start';
+ $command.='_'.$start;
} else {
- $command.='_0_$start';
+ $command.='_0_'.$start;
}
}
return &reply($command,&homeserver($uname,$udom));
}
+# --------------------------------------------------------------- Modify a user
+
+
+sub modifyuser {
+ my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene)=@_;
+ &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.
+ $umode.', '.$first.', '.$middle.', '.
+ $last.', '.$gene.' by '.
+ $ENV{'user.name'}.' at '.$ENV{'user.domain'});
+ my $uhome=&homeserver($uname,$udom);
+# ----------------------------------------------------------------- Create User
+ if (($uhome eq 'no_host') && ($umode) && ($upass)) {
+ my $unhome='';
+ if ($ENV{'course.'.$ENV{'request.course.id'}.'.domain'} eq $udom) {
+ $unhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};
+ } else {
+ my $tryserver;
+ my $loadm=10000000;
+ foreach $tryserver (keys %libserv) {
+ if ($hostdom{$tryserver} eq $udom) {
+ my $answer=reply('load',$tryserver);
+ if (($answer=~/\d+/) && ($answer<$loadm)) {
+ $loadm=$answer;
+ $unhome=$tryserver;
+ }
+ }
+ }
+ }
+ if (($unhome eq '') || ($unhome eq 'no_host')) {
+ return 'error: find home';
+ }
+ my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':'.$umode.':'.
+ &escape($upass),$unhome);
+ unless ($reply eq 'ok') {
+ return 'error: '.$reply;
+ }
+ $uhome=&homeserver($uname,$udom);
+ if (($uhome eq '') || ($uhome eq 'no_host') || ($uhome ne $unhome)) {
+ return 'error: verify home';
+ }
+ }
+# ---------------------------------------------------------------------- Add ID
+ if ($uid) {
+ $uid=~tr/A-Z/a-z/;
+ my %uidhash=&idrget($udom,$uname);
+ if (($uidhash{$uname}) && ($uidhash{$uname}!~/error\:/)) {
+ unless ($uid eq $uidhash{$uname}) {
+ return 'error: mismatch '.$uidhash{$uname}.' versus '.$uid;
+ }
+ } else {
+ &idput($udom,($uname => $uid));
+ }
+ }
+# -------------------------------------------------------------- Add names, etc
+ my %names=&get('environment',
+ ['firstname','middlename','lastname','generation'],
+ $udom,$uname);
+ if ($first) { $names{'firstname'} = $first; }
+ if ($middle) { $names{'middlename'} = $middle; }
+ if ($last) { $names{'lastname'} = $last; }
+ if ($gene) { $names{'generation'} = $gene; }
+ my $reply = &put('environment', \%names, $udom,$uname);
+ if ($reply ne 'ok') { return 'error: '.$reply; }
+ &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
+ $umode.', '.$first.', '.$middle.', '.
+ $last.', '.$gene.' by '.
+ $ENV{'user.name'}.' at '.$ENV{'user.domain'});
+ return 'ok';
+}
+
+# -------------------------------------------------------------- Modify student
+
+sub modifystudent {
+ my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
+ $end,$start)=@_;
+ my $cid='';
+ unless ($cid=$ENV{'request.course.id'}) {
+ return 'not_in_class';
+ }
+# --------------------------------------------------------------- Make the user
+ my $reply=&modifyuser
+ ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene);
+ unless ($reply eq 'ok') { return $reply; }
+ my $uhome=&homeserver($uname,$udom);
+ if (($uhome eq '') || ($uhome eq 'no_host')) {
+ return 'error: no such user';
+ }
+# -------------------------------------------------- Add student to course list
+ my $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
+ $ENV{'course.'.$cid.'.num'}.':classlist:'.
+ &escape($uname.':'.$udom).'='.
+ &escape($end.':'.$start),
+ $ENV{'course.'.$cid.'.home'});
+ unless (($reply eq 'ok') || ($reply eq 'delayed')) {
+ return 'error: '.$reply;
+ }
+# ---------------------------------------------------- Add student role to user
+ my $uurl='/'.$cid;
+ $uurl=~s/\_/\//g;
+ if ($usec) {
+ $uurl.='/'.$usec;
+ }
+ return &assignrole($udom,$uname,$uurl,'st',$end,$start);
+}
+
+# ------------------------------------------------- Write to course preferences
+
+sub writecoursepref {
+ my ($courseid,%prefs)=@_;
+ $courseid=~s/^\///;
+ $courseid=~s/\_/\//g;
+ my ($cdomain,$cnum)=split(/\//,$courseid);
+ my $chome=homeserver($cnum,$cdomain);
+ if (($chome eq '') || ($chome eq 'no_host')) {
+ return 'error: no such course';
+ }
+ my $cstring='';
+ map {
+ $cstring.=escape($_).'='.escape($prefs{$_}).'&';
+ } keys %prefs;
+ $cstring=~s/\&$//;
+ return reply('put:'.$cdomain.':'.$cnum.':environment:'.$cstring,$chome);
+}
+
+# ---------------------------------------------------------- Make/modify course
+
+sub createcourse {
+ my ($udom,$description,$url)=@_;
+ $url=&declutter($url);
+ my $cid='';
+ unless (&allowed('ccc',$ENV{'user.domain'})) {
+ return 'refused';
+ }
+ unless ($udom eq $ENV{'user.domain'}) {
+ return 'refused';
+ }
+# ------------------------------------------------------------------- Create ID
+ my $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).
+ unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
+# ----------------------------------------------- Make sure that does not exist
+ my $uhome=&homeserver($uname,$udom);
+ unless (($uhome eq '') || ($uhome eq 'no_host')) {
+ $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).
+ unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
+ $uhome=&homeserver($uname,$udom);
+ unless (($uhome eq '') || ($uhome eq 'no_host')) {
+ return 'error: unable to generate unique course-ID';
+ }
+ }
+# ------------------------------------------------------------- Make the course
+ my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::',
+ $ENV{'user.home'});
+ unless ($reply eq 'ok') { return 'error: '.$reply; }
+ my $uhome=&homeserver($uname,$udom);
+ if (($uhome eq '') || ($uhome eq 'no_host')) {
+ return 'error: no such course';
+ }
+ &writecoursepref($udom.'_'.$uname,
+ ('description' => $description,
+ 'url' => $url));
+ return '/'.$udom.'/'.$uname;
+}
+
# ---------------------------------------------------------- Assign Custom Role
sub assigncustomrole {
@@ -1309,7 +1674,7 @@ sub condval {
# --------------------------------------------------------- Value of a Variable
sub EXT {
- my $varname=shift;
+ my ($varname,$symbparm)=@_;
unless ($varname) { return ''; }
my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
my $rest;
@@ -1325,7 +1690,7 @@ sub EXT {
if ($realm eq 'user') {
# --------------------------------------------------------------- user.resource
if ($space eq 'resource') {
- my %restored=&restore;
+ my %restored=&restore();
return $restored{$qualifierrest};
# ----------------------------------------------------------------- user.access
} elsif ($space eq 'access') {
@@ -1353,7 +1718,7 @@ sub EXT {
# ---------------------------------------------------- Any other user namespace
} else {
my $item=($rest)?$qualifier.'.'.$rest:$qualifier;
- my %reply=&get($space,$item);
+ my %reply=&get($space,[$item]);
return $reply{$item};
}
} elsif ($realm eq 'request') {
@@ -1366,81 +1731,88 @@ sub EXT {
}
} elsif ($realm eq 'course') {
# ---------------------------------------------------------- course.description
- my $section='';
- if ($ENV{'request.course.sec'}) {
- $section='_'.$ENV{'request.course.sec'};
- }
- return $ENV{'course.'.$ENV{'request.course.id'}.$section.'.'.
+ return $ENV{'course.'.$ENV{'request.course.id'}.'.'.
$spacequalifierrest};
} elsif ($realm eq 'resource') {
- if ($ENV{'request.course.id'}) {
+ if ($ENV{'request.course.id'}) {
+
+# print '
'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
+
+
# ----------------------------------------------------- Cascading lookup scheme
- my $symbp=&symbread();
- my $mapp=(split(/\_\_\_/,$symbp))[0];
+ my $symbp;
+ if ($symbparm) {
+ $symbp=$symbparm;
+ } else {
+ $symbp=&symbread();
+ }
+ my $mapp=(split(/\_\_\_/,$symbp))[0];
- my $symbparm=$symbp.'.'.$spacequalifierrest;
- my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
+ my $symbparm=$symbp.'.'.$spacequalifierrest;
+ my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
- my $seclevel=
+ my $seclevel=
$ENV{'request.course.id'}.'.['.
$ENV{'request.course.sec'}.'].'.$spacequalifierrest;
- my $seclevelr=
+ my $seclevelr=
$ENV{'request.course.id'}.'.['.
$ENV{'request.course.sec'}.'].'.$symbparm;
- my $seclevelm=
+ my $seclevelm=
$ENV{'request.course.id'}.'.['.
$ENV{'request.course.sec'}.'].'.$mapparm;
- my $courselevel=
+ my $courselevel=
$ENV{'request.course.id'}.'.'.$spacequalifierrest;
- my $courselevelr=
+ my $courselevelr=
$ENV{'request.course.id'}.'.'.$symbparm;
- my $courselevelm=
+ my $courselevelm=
$ENV{'request.course.id'}.'.'.$mapparm;
-
# ----------------------------------------------------------- first, check user
- my %resourcedata=get('resourcedata',
- ($courselevelr,$courselevelm,$courselevel));
- if ($resourcedata{$courselevelr}!~/^error\:/) {
-
- if ($resourcedata{$courselevelr}) {
- return $resourcedata{$courselevelr}; }
- if ($resourcedata{$courselevelm}) {
- return $resourcedata{$courselevelm}; }
- if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
+ my %resourcedata=get('resourcedata',
+ [$courselevelr,$courselevelm,$courselevel]);
+ if (($resourcedata{$courselevelr}!~/^error\:/) &&
+ ($resourcedata{$courselevelr}!~/^con_lost/)) {
+
+ if ($resourcedata{$courselevelr}) {
+ return $resourcedata{$courselevelr}; }
+ if ($resourcedata{$courselevelm}) {
+ return $resourcedata{$courselevelm}; }
+ if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
+ } else {
+ if ($resourcedata{$courselevelr}!~/No such file/) {
+ &logthis("WARNING:".
+ " Trying to get resource data for ".$ENV{'user.name'}." at "
+ .$ENV{'user.domain'}.": ".$resourcedata{$courselevelr}.
+ "");
+ }
}
+
# -------------------------------------------------------- second, check course
- my $section='';
- if ($ENV{'request.course.sec'}) {
- $section='_'.$ENV{'request.course.sec'};
- }
+
my $reply=&reply('get:'.
- $ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.':'.
- $ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}.
- ':resourcedata:'.
- escape($seclevelr).':'.escape($seclevelm).':'.escape($seclevel).':'.
- escape($courselevelr).':'.escape($courselevelm).':'.escape($courselevel),
- $ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'});
+ $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
+ $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
+ ':resourcedata:'.
+ &escape($seclevelr).'&'.&escape($seclevelm).'&'.&escape($seclevel).'&'.
+ &escape($courselevelr).'&'.&escape($courselevelm).'&'.&escape($courselevel),
+ $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
if ($reply!~/^error\:/) {
- map {
- my ($name,$value)=split(/\=/,$_);
- $resourcedata{unescape($name)}=unescape($value);
- } split(/\&/,$reply);
-
- if ($resourcedata{$seclevelr}) { return $resourcedata{$seclevelr}; }
- if ($resourcedata{$seclevelm}) { return $resourcedata{$seclevelm}; }
- if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; }
-
- if ($resourcedata{$courselevelr}) {
- return $resourcedata{$courselevelr}; }
- if ($resourcedata{$courselevelm}) {
- return $resourcedata{$courselevelm}; }
- if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
-
+ map {
+ if ($_) { return &unescape($_); }
+ } split(/\&/,$reply);
+ }
+ if (($reply=~/^con_lost/) || ($reply=~/^error\:/)) {
+ &logthis("WARNING:".
+ " Getting ".$reply." asking for ".$varname." for ".
+ $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
+ ' at '.
+ $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
+ ' from '.
+ $ENV{'course.'.$ENV{'request.course.id'}.'.home'}.
+ "");
}
-
# ------------------------------------------------------ third, check map parms
my %parmhash=();
my $thisparm='';
@@ -1454,13 +1826,32 @@ sub EXT {
# --------------------------------------------- last, look in resource metadata
+ $spacequalifierrest=~s/\./\_/;
my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest);
if ($metadata) { return $metadata; }
+ $metadata=&metadata($ENV{'request.filename'},
+ 'parameter_'.$spacequalifierrest);
+ if ($metadata) { return $metadata; }
+
+# ------------------------------------------------------------------ Cascade up
+
+ unless ($space eq '0') {
+ my ($part,$id)=split(/\_/,$space);
+ if ($id) {
+ my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
+ $symbparm);
+ if ($partgeneral) { return $partgeneral; }
+ } else {
+ my $resourcegeneral=&EXT('resource.0.'.$qualifierrest,
+ $symbparm);
+ if ($resourcegeneral) { return $resourcegeneral; }
+ }
+ }
# ---------------------------------------------------- Any other user namespace
} elsif ($realm eq 'environment') {
# ----------------------------------------------------------------- environment
- return $ENV{$spacequalifierrest};
+ return $ENV{'environment.'.$spacequalifierrest};
} elsif ($realm eq 'system') {
# ----------------------------------------------------------------- system.time
if ($space eq 'time') {
@@ -1474,33 +1865,76 @@ sub EXT {
sub metadata {
my ($uri,$what)=@_;
+
$uri=&declutter($uri);
- unless ($uri=~/\.meta$/) { $uri.='.meta'; }
+ my $filename=$uri;
+ $uri=~s/\.meta$//;
unless ($metacache{$uri.':keys'}) {
- my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$uri);
+ my %metathesekeys=();
+ unless ($filename=~/\.meta$/) { $filename.='.meta'; }
+ my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename);
my $parser=HTML::TokeParser->new(\$metastring);
my $token;
+ undef %metathesekeys;
while ($token=$parser->get_token) {
if ($token->[0] eq 'S') {
+ if (defined($token->[2]->{'package'})) {
+ my $package=$token->[2]->{'package'};
+ my $keyroot='';
+ if (defined($token->[2]->{'part'})) {
+ $keyroot.='_'.$token->[2]->{'part'};
+ }
+ if (defined($token->[2]->{'id'})) {
+ $keyroot.='_'.$token->[2]->{'id'};
+ }
+ if ($metacache{$uri.':packages'}) {
+ $metacache{$uri.':packages'}.=','.$package.$keyroot;
+ } else {
+ $metacache{$uri.':packages'}=$package.$keyroot;
+ }
+ map {
+ if ($_=~/^$package\&/) {
+ my ($pack,$name,$subp)=split(/\&/,$_);
+ my $value=$packagetab{$_};
+ my $part=$keyroot;
+ $part=~s/^\_//;
+ if ($subp eq 'display') {
+ $value.=' [Part: '.$part.']';
+ }
+ my $unikey='parameter'.$keyroot.'_'.$name;
+ $metathesekeys{$unikey}=1;
+ $metacache{$uri.':'.$unikey.'.part'}=$part;
+ unless
+ (defined($metacache{$uri.':'.$unikey.'.'.$subp})) {
+ $metacache{$uri.':'.$unikey.'.'.$subp}=$value;
+ }
+ }
+ } keys %packagetab;
+ } else {
my $entry=$token->[1];
my $unikey=$entry;
- if ($token->[2]->{'part'}) {
+ if (defined($token->[2]->{'part'})) {
$unikey.='_'.$token->[2]->{'part'};
}
- if ($token->[2]->{'name'}) {
- $unikey.='_'.$token->[2]->{'name'};
+ if (defined($token->[2]->{'id'})) {
+ $unikey.='_'.$token->[2]->{'id'};
}
- if ($metacache{$uri.':keys'}) {
- $metacache{$uri.':keys'}.=','.$unikey;
- } else {
- $metacache{$uri.':keys'}=$unikey;
+ if (defined($token->[2]->{'name'})) {
+ $unikey.='_'.$token->[2]->{'name'};
}
+ $metathesekeys{$unikey}=1;
map {
$metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_};
- } $token->[3];
- $metacache{$uri.':'.$unikey}=$parser->get_text('/'.$entry);
- }
+ } @{$token->[3]};
+ unless (
+ $metacache{$uri.':'.$unikey}=$parser->get_text('/'.$entry)
+ ) { $metacache{$uri.':'.$unikey}=
+ $metacache{$uri.':'.$unikey.'.default'};
+ }
+ }
+ }
}
+ $metacache{$uri.':keys'}=join(',',keys %metathesekeys);
}
return $metacache{$uri.':'.$what};
}
@@ -1612,18 +2046,43 @@ sub numval {
sub rndseed {
my $symb;
unless ($symb=&symbread()) { return time; }
- my $symbchck=unpack("%32C*",$symb);
- my $symbseed=numval($symb)%$symbchck;
- my $namechck=unpack("%32C*",$ENV{'user.name'});
- my $nameseed=numval($ENV{'user.name'})%$namechck;
- return int( $symbseed
- .$nameseed
- .unpack("%32C*",$ENV{'user.domain'})
- .unpack("%32C*",$ENV{'request.course.id'})
- .$namechck
- .$symbchck);
+ {
+ use integer;
+ my $symbchck=unpack("%32C*",$symb) << 27;
+ my $symbseed=numval($symb) << 22;
+ my $namechck=unpack("%32C*",$ENV{'user.name'}) << 17;
+ my $nameseed=numval($ENV{'user.name'}) << 12;
+ my $domainseed=unpack("%32C*",$ENV{'user.domain'}) << 7;
+ my $courseseed=unpack("%32C*",$ENV{'request.course.id'});
+ my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck;
+ #uncommenting these lines can break things!
+ #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
+ #&Apache::lonxml::debug("rndseed :$num:$symb");
+ return $num;
+ }
}
+sub ireceipt {
+ my ($funame,$fudom,$fucourseid,$fusymb)=@_;
+ my $cuname=unpack("%32C*",$funame);
+ my $cudom=unpack("%32C*",$fudom);
+ my $cucourseid=unpack("%32C*",$fucourseid);
+ my $cusymb=unpack("%32C*",$fusymb);
+ my $cunique=unpack("%32C*",$perlvar{'lonReceipt'});
+ return unpack("%32C*",$perlvar{'lonHostID'}).'-'.
+ ($cunique%$cuname+
+ $cunique%$cudom+
+ $cusymb%$cuname+
+ $cusymb%$cudom+
+ $cucourseid%$cuname+
+ $cucourseid%$cudom);
+}
+
+sub receipt {
+ return &ireceipt($ENV{'user.name'},$ENV{'user.domain'},
+ $ENV{'request.course.id'},&symbread());
+}
+
# ------------------------------------------------------------ Serves up a file
# returns either the contents of the file or a -1
sub getfile {
@@ -1756,6 +2215,21 @@ if ($readit ne 'done') {
}
}
+# ---------------------------------------------------------- Read package table
+{
+ my $config=Apache::File->new("$perlvar{'lonTabDir'}/packages.tab");
+
+ while (my $configline=<$config>) {
+ chomp($configline);
+ my ($short,$plain)=split(/:/,$configline);
+ my ($pack,$name)=split(/\&/,$short);
+ if ($plain ne '') {
+ $packagetab{$pack.'&'.$name.'&name'}=$name;
+ $packagetab{$short}=$plain;
+ }
+ }
+}
+
# ------------------------------------------------------------- Read file types
{
my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");