--- loncom/publisher/lonpublisher.pm 2001/03/22 22:41:01 1.18 +++ loncom/publisher/lonpublisher.pm 2001/08/11 18:06:25 1.34 @@ -6,6 +6,12 @@ # 05/29/00,05/30,10/11 Gerd Kortemeyer) # # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer +# 03/23 Guy Albertelli +# 03/24,03/29,04/03 Gerd Kortemeyer +# 04/16/2001 Scott Harrison +# 05/03,05/05,05/07 Gerd Kortemeyer +# 05/28/2001 Scott Harrison +# 06/23,08/07,08/11 Gerd Kortemeyer package Apache::lonpublisher; @@ -16,6 +22,8 @@ use Apache::Constants qw(:common :http : use HTML::TokeParser; use Apache::lonxml; use Apache::lonhomework; +use Apache::loncacc; +use DBI; my %addid; my %nokey; @@ -27,6 +35,9 @@ my %metadatakeys; my $docroot; +my $cuname; +my $cudom; + # ----------------------------------------------- Evaluate string with metadata sub metaeval { @@ -38,9 +49,15 @@ sub metaeval { if ($token->[0] eq 'S') { my $entry=$token->[1]; my $unikey=$entry; + if (defined($token->[2]->{'package'})) { + $unikey.='_package_'.$token->[2]->{'package'}; + } if (defined($token->[2]->{'part'})) { $unikey.='_'.$token->[2]->{'part'}; } + if (defined($token->[2]->{'id'})) { + $unikey.='_'.$token->[2]->{'id'}; + } if (defined($token->[2]->{'name'})) { $unikey.='_'.$token->[2]->{'name'}; } @@ -82,6 +99,14 @@ sub metaread { return '
Processed file: '.$fn.''; } +# ---------------------------- convert 'time' format into a datetime sql format +sub sqltime { + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = + localtime(@_[0]); + $mon++; $year+=1900; + return "$year-$mon-$mday $hour:$min:$sec"; +} + # --------------------------------------------------------- Various form fields sub textfield { @@ -108,11 +133,20 @@ sub selectbox { # -------------------------------------------------------- Publication Step One +sub makeallowed { +} + +sub urlfixup { + return shift; +} + sub publish { my ($source,$target,$style)=@_; my $logfile; my $scrout=''; + my $allmeta=''; + my $content=''; unless ($logfile=Apache::File->new('>>'.$source.'.log')) { return @@ -136,7 +170,7 @@ sub publish { my $maxindex=10; my $maxid=10; - my $content=''; + my $needsfixup=0; { @@ -173,42 +207,62 @@ sub publish { print $logfile "Needs ID and/or index fixup\n". "Max ID : $maxid (min 10)\n". "Max Index: $maxindex (min 10)\n"; - + } my $outstring=''; my $parser=HTML::TokeParser->new(\$content); my $token; while ($token=$parser->get_token) { if ($token->[0] eq 'S') { - my $counter; - if ($counter=$addid{$token->[1]}) { + my $counter; + my $tag=$token->[1]; + unless ($tag eq 'allow') { + my %parms=%{$token->[2]}; + if ($counter=$addid{$tag}) { if ($counter eq 'id') { - if (defined($token->[2]->{'id'})) { - $outstring.=$token->[4]; - } else { + unless (defined($parms{'id'})) { $maxid++; - my $thisid=' id="'.$maxid.'"'; - my $fixup=$token->[4]; - $fixup=~s/(\<\w+)/$1$thisid/; - $outstring.=$fixup; - print $logfile 'ID: '.$fixup."\n"; + $parms{'id'}=$maxid; + print $logfile 'ID: '.$tag.':'.$maxid."\n"; } - } else { - if (defined($token->[2]->{'index'})) { - $outstring.=$token->[4]; - } else { + } elsif ($counter eq 'index') { + unless (defined($parms{'index'})) { $maxindex++; - my $thisindex=' index="'.$maxindex.'"'; - my $fixup=$token->[4]; - $fixup=~s/(\<\w+)/$1$thisindex/; - $outstring.=$fixup; - print $logfile 'Index: '.$fixup."\n"; + $parms{'index'}=$maxindex; + print $logfile 'Index: '.$tag.':'.$maxindex."\n"; } } - } else { - $outstring.=$token->[4]; - } + } + + map { + if (defined($parms{$_})) { + my $oldurl=$parms{$_}; + my $newurl=&urlfixup($oldurl); + if ($newurl ne $oldurl) { + $parms{$_}=$newurl; + print $logfile 'URL: '.$tag.':'.$oldurl.' - '. + $newurl."\n"; + } + &makeallowed($newurl); + } + } ('src','href','codebase'); + + my $newparmstring=''; + my $endtag=''; + map { + if ($_ eq '/') { + $endtag=' /'; + } else { + my $quote=($parms{$_}=~/\"/?"'":'"'); + $newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote; + } + } keys %parms; + + $outstring.='<'.$tag.$newparmstring.$endtag.'>'; + } } elsif ($token->[0] eq 'E') { - $outstring.=$token->[2]; + unless ($token->[1] eq 'allow') { + $outstring.=$token->[2]; + } } else { $outstring.=$token->[1]; } @@ -223,6 +277,8 @@ sub publish { print $org $outstring; } $content=$outstring; + + if ($needsfixup) { print $logfile "End of ID and/or index fixup\n". "Max ID : $maxid (min 10)\n". "Max Index: $maxindex (min 10)\n"; @@ -247,17 +303,17 @@ sub publish { $ENV{'environment.generation'}; $metadatafields{'author'}=~s/\s+/ /g; $metadatafields{'author'}=~s/\s+$//; - $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'}; + $metadatafields{'owner'}=$cuname.'@'.$cudom; # ------------------------------------------------ Check out directory hierachy my $thisdisfn=$source; - $thisdisfn=~s/^\/home\/$ENV{'user.name'}\///; + $thisdisfn=~s/^\/home\/$cuname\///; my @urlparts=split(/\//,$thisdisfn); $#urlparts--; - my $currentpath='/home/'.$ENV{'user.name'}.'/'; + my $currentpath='/home/'.$cuname.'/'; map { $currentpath.=$_.'/'; @@ -288,8 +344,9 @@ sub publish { # -------------------------------------------------- Parse content for metadata - my $allmeta=Apache::lonxml::xmlparse('meta',$content); -# &metaeval($allmeta); + $allmeta=Apache::lonxml::xmlparse('meta',$content); + + &metaeval($allmeta); # ---------------- Find and document discrepancies in the parameters and stores @@ -312,7 +369,8 @@ sub publish { my $chparms=''; map { if (($_=~/^parameter/) || ($_=~/^stores/)) { - unless (($metadatafields{$_.'.name'}) || ($_=~/\.\w+$/)) { + unless (($metadatafields{$_.'.name'}) || + ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) { print $logfile 'Obsolete: '.$_."\n"; $chparms.=$_.' '; } @@ -322,7 +380,7 @@ sub publish { $scrout.='

Obsolete parameters or stored values: '. $chparms; } - + } # ------------------------------------------------------- Now have all metadata $scrout.= @@ -406,7 +464,6 @@ sub publish { $scrout.=&selectbox('Copyright/Distribution','copyright', $metadatafields{'copyright'},%cprtag); - } return $scrout. '

'; } @@ -415,7 +472,7 @@ sub publish { sub phasetwo { - my ($source,$target,$style)=@_; + my ($source,$target,$style,$distarget)=@_; my $logfile; my $scrout=''; @@ -479,6 +536,69 @@ sub phasetwo { print $logfile "\nWrote metadata"; } +# -------------------------------- Synchronize entry with SQL metadata database + my %perlvar; + open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; + my $configline; + while ($configline=) { + if ($configline =~ /PerlSetVar/) { + my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); + chomp($varvalue); + $perlvar{$varname}=$varvalue; + } + } + close(CONFIG); + + my $warning; + my $dbh; + { + unless ( + $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0}) + ) { + $warning='WARNING: Cannot connect to '. + 'database!'; + } + else { + my %sqldatafields; + $sqldatafields{'url'}=$distarget; + my $sth=$dbh->prepare( + 'delete from metadata where url like binary'. + '"'.$sqldatafields{'url'}.'"'); + $sth->execute(); + map {my $field=$metadatafields{$_}; $field=~s/\"/\'\'/g; + $sqldatafields{$_}=$field;} + ('title','author','subject','keywords','notes','abstract', + 'mime','language','creationdate','lastrevisiondate','owner', + 'copyright'); + + $sth=$dbh->prepare('insert into metadata values ('. + '"'.delete($sqldatafields{'title'}).'"'.','. + '"'.delete($sqldatafields{'author'}).'"'.','. + '"'.delete($sqldatafields{'subject'}).'"'.','. + '"'.delete($sqldatafields{'url'}).'"'.','. + '"'.delete($sqldatafields{'keywords'}).'"'.','. + '"'.'current'.'"'.','. + '"'.delete($sqldatafields{'notes'}).'"'.','. + '"'.delete($sqldatafields{'abstract'}).'"'.','. + '"'.delete($sqldatafields{'mime'}).'"'.','. + '"'.delete($sqldatafields{'language'}).'"'.','. + '"'. + sqltime(delete($sqldatafields{'creationdate'})) + .'"'.','. + '"'. + sqltime(delete( + $sqldatafields{'lastrevisiondate'})).'"'.','. + '"'.delete($sqldatafields{'owner'}).'"'.','. + '"'.delete( + $sqldatafields{'copyright'}).'"'.')'); + $sth->execute(); + $dbh->disconnect; + $scrout.='

Synchronized SQL metadata database'; + print $logfile "\nSynchronized SQL metadata database"; + } + } + + # ----------------------------------------------------------- Copy old versions if (-e $target) { @@ -596,13 +716,52 @@ if (-e $target) { } +# ---------------------------------------- Send update notifications, meta only + +{ + + my $filename; + + $target=~/(.*)\/([^\/]+)$/; + my $srcf=$2.'.meta'; + opendir(DIR,$1); + while ($filename=readdir(DIR)) { + if ($filename=~/$srcf\.(\w+)$/) { + my $subhost=$1; + if ($subhost ne 'meta') { + $scrout.= + '

Notifying host for metadata only '.$subhost.':'; + print $logfile + "\nNotifying host for metadata only '.$subhost.':'"; + my $reply=&Apache::lonnet::critical( + 'update:'.$target.'.meta',$subhost); + $scrout.=$reply; + print $logfile $reply; + } + } + } + closedir(DIR); + +} + # ------------------------------------------------ Provide link to new resource my $thisdistarget=$target; $thisdistarget=~s/^$docroot//; - return $scrout. - '

View Target'; + my $thissrc=$source; + $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/; + + my $thissrcdir=$thissrc; + $thissrcdir=~s/\/[^\/]+$/\//; + + + return $warning.$scrout. + '


View Target'. + '

Back to Source'. + '

Back to Source Directory'; + } # ================================================================ Main Handler @@ -616,21 +775,33 @@ sub handler { return OK; } -unless ($ENV{'form.pubdir'}) { # -------------------------------------------------------------- Check filename my $fn=$ENV{'form.filename'}; + unless ($fn) { - $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. + $r->log_reason($cuname.' at '.$cudom. ' trying to publish empty filename', $r->filename); return HTTP_NOT_FOUND; } - unless ($ENV{'user.home'} eq $r->dir_config('lonHostID')) { - $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. + ($cuname,$cudom)= + &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); + unless (($cuname) && ($cudom)) { + $r->log_reason($cuname.' at '.$cudom. + ' trying to publish file '.$ENV{'form.filename'}. + ' ('.$fn.') - not authorized', + $r->filename); + return HTTP_NOT_ACCEPTABLE; + } + + unless (&Apache::lonnet::homeserver($cuname,$cudom) + eq $r->dir_config('lonHostID')) { + $r->log_reason($cuname.' at '.$cudom. ' trying to publish file '.$ENV{'form.filename'}. - ' ('.$fn.') - not homeserver ('.$ENV{'user.home'}.')', + ' ('.$fn.') - not homeserver ('. + &Apache::lonnet::homeserver($cuname,$cudom).')', $r->filename); return HTTP_NOT_ACCEPTABLE; } @@ -639,19 +810,19 @@ unless ($ENV{'form.pubdir'}) { my $targetdir=''; $docroot=$r->dir_config('lonDocRoot'); - if ($1 ne $ENV{'user.name'}) { - $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. + if ($1 ne $cuname) { + $r->log_reason($cuname.' at '.$cudom. ' trying to publish unowned file '.$ENV{'form.filename'}. ' ('.$fn.')', $r->filename); return HTTP_NOT_ACCEPTABLE; } else { - $targetdir=$docroot.'/res/'.$ENV{'user.domain'}; + $targetdir=$docroot.'/res/'.$cudom; } unless (-e $fn) { - $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. + $r->log_reason($cuname.' at '.$cudom. ' trying to publish non-existing file '.$ENV{'form.filename'}. ' ('.$fn.')', $r->filename); @@ -729,71 +900,36 @@ unless ($ENV{'form.phase'} eq 'two') { $thisdistarget=~s/^$docroot//; my $thisdisfn=$thisfn; - $thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///; + $thisdisfn=~s/^\/home\/$cuname\/public_html\///; $r->print('

Publishing '. &Apache::lonnet::filedescription($thistype).' '. $thisdisfn.'

Target: '.$thisdistarget.'

'); + + if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) { + $r->print('

Co-Author: '.$cuname.' at '.$cudom. + '

'); + } + + if (&Apache::lonnet::fileembstyle($thistype) eq 'ssi') { + $r->print('
Diffs with Current Version

'); + } # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle unless ($ENV{'form.phase'} eq 'two') { - $r->print('


'.&publish($thisfn,$thistarget,$thisembstyle)); + $r->print( + '
'.&publish($thisfn,$thistarget,$thisembstyle)); } else { - $r->print('
'.&phasetwo($thisfn,$thistarget,$thisembstyle)); + $r->print( + '
'.&phasetwo($thisfn,$thistarget,$thisembstyle,$thisdistarget)); } } $r->print(''); -} else { - - my $fn=$ENV{'form.filename'}; - - $fn=~s/\/[^\/]+$//; - my $thisprefix=$fn; - $thisprefix=~s/\/\~/\/priv\//; - - $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; - - unless ($fn) { - $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. - ' trying to publish empty directory', $r->filename); - return HTTP_NOT_FOUND; - } - -# ----------------------------------------------------------- Start page output - - $r->content_type('text/html'); - $r->send_http_header; - - $r->print('LON-CAPA Publishing Directory'); - $r->print( - ''); - - my $thisdisfn=$fn; - $thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///; - - $r->print('

Publishing directory '.$thisdisfn.'

'); - my $i=0; - $r->print(''); - $r->print(''); - -} return OK; }