All new accounts created on Gitlab now require administrator approval. If you invite any collaborators, please let Flux staff know so they can approve the accounts.

Commit 6e10819e authored by Leigh B. Stoller's avatar Leigh B. Stoller

Primitive archive viewer. As usual, its quicker to write it myself

then find one and adapt. Of course, I did say my version was
primitive, but it does all the things I think it needs to do!
parent 9fb1f5a9
......@@ -934,7 +934,7 @@ sub Replace($$$)
if (-e $zipfile) {
# print STDERR "ArchiveReplace: renaming $zipfile to $savefile\n";
if (!rename($zipfile, $savefile)) {
if (!rename($zipfile, $savefile)) {
print STDERR "ArchiveReplace: Could not backup $zipfile!\n";
goto bad;
}
......@@ -1620,5 +1620,51 @@ sub GenerateTag($$)
return $newtag;
}
#
# Return pointer to zip archive file.
#
sub ZipFile($;$$)
{
my ($self, $view, $tag) = @_;
return undef
if (! ref($self));
my $archive_idx = $self->idx();
$view = $defaultview
if (!defined($view));
my $View = $self->View($view);
return undef
if (!defined($View));
# Cannot list if there are no revisions.
return undef
if (!defined($View->{'revision'}));
my $directory = $self->directory();
my $repodir = "$directory/$REPO/$view";
# Where to find what we want.
my $revision;
if (defined($tag)) {
my $revision_row = $self->Revision($view, $tag);
if (!defined($revision_row)) {
print STDERR "ArchiveList: ".
"Could not locate a revision for $view/$tag in $self\n";
return undef;
}
$revision = $revision_row->{'revision'};
}
else {
# Trunk, sorta.
$revision = $View->{'revision'};
}
return "$repodir/${revision}.zip";
}
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -6,6 +6,9 @@
#
use English;
use Getopt::Std;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use POSIX qw(strftime);
use File::Basename;
#
# Command line interface to experiment archive module.
......@@ -13,12 +16,14 @@ use Getopt::Std;
sub usage()
{
print STDERR
"Usage: archive_list [-t tag] <idx> <view>\n";
"Usage: archive_list [-t tag] [-i file] <idx> <view>\n";
exit(-1);
}
my $optlist = "dt:";
my $optlist = "dt:i:q:";
my $debug = 0;
my $tag = undef;
my $file = undef;
my $query = undef;
#
# Configure variables
......@@ -69,6 +74,9 @@ if (defined($options{"d"})) {
$debug = 1;
Archive->setdebug(1);
}
if (defined($options{"q"})) {
$query = $options{"q"};
}
if (defined($options{"t"})) {
$tag = $options{"t"};
......@@ -79,6 +87,16 @@ if (defined($options{"t"})) {
fatal("Bad data in tag: $tag");
}
}
if (defined($options{"i"})) {
$file = $options{"i"};
if ($file =~ /^([\d]*)$/) {
$file = $1;
}
else {
fatal("Bad data in file: $file");
}
}
if (@ARGV != 2) {
usage();
}
......@@ -92,15 +110,184 @@ else {
fatal("Bad data in view: $archive_view");
}
# Derive the URL we need to use. Need to scrub out the file argument since
# we are going to replace that.
my $url = "archive_list.php?";
if (defined($query)) {
$query =~ s/&file=\d*//;
$url .= $query . "&";
}
#
#
# Find the archive and issue the list command. We just dump the whole
# thing to stdout.
#
my $archive = Archive->Lookup($archive_idx);
if (!defined($archive)) {
fatal("Could not map archive $archive_idx to its object");
}
exit($archive->List(undef, $archive_view, 1, $tag));
my $zipfile = $archive->ZipFile($archive_view, $tag);
if (!defined($zipfile)) {
fatal("Could not find zipfile for $archive_view in $archive");
}
if (! -e $zipfile) {
fatal("Could not find zipfile $zipfile");
}
#
# I guess this code should be in the Archive Library?
#
my $zip = Archive::Zip->new($zipfile);
my @members = $zip->members();
my $index = 0;
#
# Spit a member
#
sub SpitMember($$$)
{
my ($index, $member, $fname) = @_;
my $size = sprintf("%10s", $member->uncompressedSize());
my $mtime = $member->lastModTime();
# $size =~ s/ /&nbsp;/g;
# $size .= "&nbsp;&sbsp;";
return "${size} " . strftime("%+", gmtime($mtime)) .
" " . "<a href=${url}file=$index>$fname</a>\n";
}
#
# Spit out the header info.
#
sub SpitHeader($;$)
{
my ($type, $fname) = @_;
if ($type eq "listing") {
return "Content-Type: text/html\n";
}
elsif ($type eq "textfile") {
return "Content-Type: text/plain\n";
}
elsif ($type eq "binary") {
return "Content-Type: application/octet-stream\n".
"Content-Disposition: attachment; filename=$fname\n";
}
return "";
}
#
# No target file/dir, find the top level entries and spit back.
#
if (!defined($file)) {
print SpitHeader("listing") . "\n";
print "<pre>";
foreach my $member (@members) {
my $fname = $member->fileName();
if ($fname =~ /^([^\/]*)\/$/) {
print SpitMember($index, $member, $fname);
}
$index++;
}
print "</pre>\n";
exit(0);
}
#
# Handle a directory, expanding it.
#
sub HandleDirectory($$)
{
my ($index, $dirmember) = @_;
print SpitHeader("listing") . "\n";
print "<pre>";
# Show .
print SpitMember($index, $dirmember, ".");
# Find directory one level up and show ..
my $dotdotname = dirname($dirmember->fileName()) . "/";
$index = 0;
foreach my $member (@members) {
my $fname = $member->fileName();
if ($dotdotname eq $fname) {
print SpitMember($index, $member, "..");
last;
}
$index++;
}
#
# We want to find all the toplevel entries in the directory.
#
my $dirname = $dirmember->fileName();
$index = 0;
foreach my $member (@members) {
my $fname = $member->fileName();
if ($dirname eq $fname) {
;
}
elsif ($fname =~ /^${dirname}([^\/]*(\/)?)$/) {
print SpitMember($index, $member, $1);
}
$index++;
}
print "</pre>\n";
return 0;
}
#
# Handle a file; spitting it out.
#
sub HandleFile($$)
{
my ($index, $member) = @_;
if ($member->isTextFile()) {
print SpitHeader("textfile") . "\n";
}
elsif ($member->isBinaryFile()) {
print SpitHeader("binary", basename($member->fileName())) . "\n";
}
print $member->contents();
return 0;
}
#
# Handle a single member, whatever it is.
#
sub HandleMember($$)
{
my ($index, $member) = @_;
if ($member->isDirectory()) {
return HandleDirectory($index, $member);
}
elsif ($member->isTextFile() || $member->isBinaryFile()) {
return HandleFile($index, $member);
}
fatal("HandleMember: Unknown type for ". $member->fileName());
}
#
# Find the target. If its a directory, do another listing. Otherwise
# spit out the file.
#
foreach $member (@members) {
if ($index == $file) {
exit(HandleMember($index, $member));
}
$index++;
}
fatal("Could not find archive member $file in $zipfile");
sub fatal($)
{
......
......@@ -20,6 +20,7 @@ $optargs = OptionalPageArguments("index", PAGEARG_INTEGER,
"experiment", PAGEARG_EXPERIMENT,
"instance", PAGEARG_INSTANCE,
"template", PAGEARG_TEMPLATE,
"file", PAGEARG_INTEGER,
"tag", PAGEARG_STRING);
if (! (isset($experiment) || isset($instance) ||
......@@ -87,6 +88,9 @@ elseif (isset($index)) {
"archive in $pid/$eid!", 1);
}
}
# This gets scrubbed ...
$query = escapeshellcmd($_SERVER["QUERY_STRING"]);
#
# A cleanup function to keep the child from becoming a zombie.
......@@ -106,19 +110,27 @@ register_shutdown_function("SPEWCLEANUP");
ignore_user_abort(1);
# Pass the tag through.
$tagopt = (isset($tag) ? "-t " . escapeshellarg($tag) : "");
$options = (isset($tag) ? "-t " . escapeshellarg($tag) : "");
$options .= " -q $query ";
$options .= (isset($file) ? " -i " . escapeshellarg($file) : "");
$fp = popen("$TBSUEXEC_PATH $uid ".
" $pid,$gid webarchive_list $tagopt $archive_idx $idx", "r");
" $pid,$gid webarchive_list $options $archive_idx $idx",
"r");
if (! $fp) {
USERERROR("Archive listing failed!", 1);
}
header("Content-Type: text/plain");
header("Expires: Mon, 26 Jul 1997 05:00:00 GMT");
header("Cache-Control: no-cache, must-revalidate");
header("Pragma: no-cache");
#
# Yuck. Since we cannot tell php to shut up and not print headers, we have to
# 'merge' headers from the backend with PHPs.
#
while ($line = fgets($fp)) {
# This indicates the end of headers
if ($line == "\n") { break; }
header(rtrim($line));
}
flush();
fpassthru($fp);
$fp = 0;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment