Commit 6e10819e authored by Leigh Stoller's avatar Leigh 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