/usr/bin/httpindex is in swish++ 6.1.5-4.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | #! /usr/bin/perl
##
# SWISH++
# httpindex
#
# Copyright (C) 1998 Paul J. Lucas
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
##
########## You shouldn't have to change anything below this line. #############
require 5.003;
use File::Basename;
use File::Path;
use FileHandle;
use Getopt::Std;
use IPC::Open2;
use lib '/usr/lib/swish++';
require WWW;
$me = basename( $0 );
# options from index(1) we accept
$index_opts = 'Ac:C:e:E:f:F:g:h:i:m:M:p:s:t:T:W:';
getopts( "${index_opts}dDv:" ) or die "$me: error in command-line options\n";
die "$me: -d and -D are mutually exclusive\n" if $opt_d && $opt_D;
##
# We have to reconstruct a set of options and their arguments from the options
# actually specified.
##
for ( split( /:/, $index_opts ) ) {
my $v = eval "\$opt_$_";
push( @index_opts, "-$_$v" ) if $v;
}
open2( \*INDEX_STDOUT, \*INDEX_STDIN, "/usr/bin/index++ @index_opts -v4 -" );
while ( <> ) {
next unless /-> "([^"]+)"/;
my $path = $1;
# Got a file from wget: give it to index(1)
print INDEX_STDIN "$path\n";
# Record the name of the top-level directory (once).
( $dir = $path ) =~ s!/.+!! unless $dir;
# Wait for index(1) to index the file by doing a blocking read. Skip
# blank lines and informational lines from index(1) about generating
# partial indicies.
do {
$_ = <INDEX_STDOUT>;
} while ( /^$|partial/ );
if ( $opt_d ) {
my $desc = WWW::extract_description( $path );
if ( $desc ) {
if ( open( FILE, ">$path" ) ) {
print FILE "$desc\n";
close FILE;
} else {
warn "$me: can not overwrite $path\n";
}
} else {
unlink( $path );
}
} elsif ( $opt_D ) {
unlink( $path );
}
if ( $opt_v < 4 ) {
next if /\(skipped:/;
if ( $opt_v < 3 ) {
next if /^ /;
next if $opt_v < 2;
}
}
print;
}
close INDEX_STDIN;
##
# We must actually read the remaining output from index(1) regardless of
# whether we print it otherwise index(1) might block.
##
while ( <INDEX_STDOUT> ) {
print if $opt_v;
}
rmtree( $dir ) if $opt_D; # remove (empty) directory tree
|