dirlist.cgi.in - w3m - Unnamed repository; edit this file to name it for gitweb.

dirlist.cgi.in (10904B)
      1 #!@PERL@
      2 #
      3 # Directory list CGI by Hironori Sakamoto (hsaka@mth.biglobe.ne.jp)
      4 #
      5 
      6 if ( $^O =~ /^(ms)?(dos|win(32|nt)?)/i ) {
      7   $WIN32 = 1;
      8   $CYGPATH = 1;
      9 }
     10 elsif ( $^O =~ /cygwin|os2/i ) {
     11   $WIN32 = 1;
     12   $CYGPATH = 0;
     13 }
     14 else {
     15   $WIN32 = 0;
     16   $CYGPATH = 0;
     17 }
     18 $RC_DIR = '@RC_DIR@';
     19 $RC_DIR =~ s@^~/@$ENV{'HOME'}/@;
     20 if ($CYGPATH) {
     21   $RC_DIR = &cygwin_pathconv("$RC_DIR");
     22 }
     23 $CONFIG = "$RC_DIR/dirlist";
     24 $CGI = $ENV{'SCRIPT_NAME'} || $0;
     25 $CGI = "file://" . &file_encode("$CGI");
     26 
     27 $AFMT = '<a href="%s"><nobr>%s</nobr></a>';
     28 $NOW = time();
     29 
     30 @OPT = &init_option($CONFIG);
     31 
     32 $query = $ENV{'QUERY_STRING'};
     33 $dir = '';
     34 $cmd = '';
     35 $cookie = '';
     36 $local_cookie = '';
     37 foreach(split(/\&/, $query)) {
     38   if (s/^dir=//) {
     39     $dir = &form_decode($_);
     40   }
     41 }
     42 $body = undef;
     43 if ($ENV{'REQUEST_METHOD'} eq 'POST') {
     44   sysread(STDIN, $body, $ENV{'CONTENT_LENGTH'});
     45   foreach(split(/\&/, $body)) {
     46     if (s/^dir=//) {
     47       $dir = &form_decode($_);
     48     } elsif (s/^opt(\d+)=//) {
     49       $OPT[$1] = $_;
     50     } elsif (s/^cmd=//) {
     51       $cmd = $_;
     52     } elsif (s/^cookie=//) {
     53       $cookie = &form_decode($_);
     54     }
     55   }
     56 }
     57 $cookie_file = $ENV{'LOCAL_COOKIE_FILE'};
     58 if (-f $cookie_file) {
     59    open(F, "< $cookie_file");
     60    $local_cookie = <F>;
     61    close(F);
     62 }
     63 if ($local_cookie eq '' || (defined($body) && $cookie ne $local_cookie)) {
     64   print <<EOF;
     65 Content-Type: text/plain
     66 
     67 Local cookie doesn't match: It may be an illegal execution
     68 EOF
     69   exit(1);
     70 }
     71 $local_cookie =  &html_quote($local_cookie);
     72 if ($dir !~ m@/$@) {
     73   $dir .= '/';
     74 }
     75 if ($dir =~ m@^/@ && $CYGPATH) {
     76   $dir = &cygwin_pathconv("$dir");
     77 }
     78 $ROOT = '';
     79 if ($WIN32) {
     80   if (($dir =~ s@^//[^/]+@@) || ($dir =~ s@^[a-z]:@@i)) {
     81     $ROOT = $&;
     82   }
     83   if ($CYGPATH) {
     84       $ROOT = &cygwin_pathconv("$ROOT");
     85   }
     86 }
     87 $dir = &cleanup($dir);
     88 
     89 $TYPE   = $OPT[$OPT_TYPE];
     90 $FORMAT = $OPT[$OPT_FORMAT];
     91 $SORT   = $OPT[$OPT_SORT];
     92 if ($cmd) {
     93   &update_option($CONFIG);
     94 }
     95 
     96 $qdir = "$ROOT" . &html_quote("$dir");
     97 $edir = "$ROOT" . &file_encode("$dir");
     98 if (! opendir(DIR, "$ROOT$dir")) {
     99   print <<EOF;
    100 Content-Type: text/html
    101 
    102 <html>
    103 <head>
    104 <title>Directory list of $qdir</title>
    105 </head>
    106 <body>
    107 <b>$qdir</b>: $! !
    108 </body>
    109 </html>
    110 EOF
    111   exit 1;
    112 }
    113 
    114 print <<EOF;
    115 Content-Type: text/html
    116 
    117 <html>
    118 <head>
    119 <title>Directory list of $qdir</title>
    120 </head>
    121 <body>
    122 <h1>Directory list of $qdir</h1>
    123 EOF
    124 &print_form($qdir, @OPT);
    125 print <<EOF;
    126 <hr>
    127 EOF
    128 $dir =~ s@/$@@;
    129 @sdirs = split('/', $dir);
    130 $_ = $sdirs[0];
    131 if ($_ eq '') {
    132   $_ = '/';
    133 }
    134 if ($TYPE eq $TYPE_TREE) {
    135   print <<EOF;
    136 <table hborder width="640">
    137 <tr valign=top><td width="160">
    138 <pre>
    139 EOF
    140   $q = "$ROOT". &html_quote("$_");
    141   $e = "$ROOT" . &file_encode("$_");
    142   if ($dir =~ m@^$@) {
    143     $n = "\" name=\"current";
    144   } else {
    145     $n = '';
    146   }
    147   printf("$AFMT\n", "$e$n", "<b>$q</b>");
    148   $N = 0;
    149   $SKIPLINE = "";
    150 
    151   &left_dir('', @sdirs);
    152 
    153   print <<EOF;
    154 </pre>
    155 </td><td width="400">
    156 <pre>$SKIPLINE
    157 EOF
    158 } else {
    159   print <<EOF;
    160 <pre>
    161 EOF
    162 }
    163 
    164 &right_dir($dir);
    165 
    166 if ($TYPE eq $TYPE_TREE) {
    167   print <<EOF;
    168 </pre>
    169 </td></tr>
    170 </table>
    171 </body>
    172 </html>
    173 EOF
    174 } else {
    175   print <<EOF;
    176 </pre>
    177 </body>
    178 </html>
    179 EOF
    180 }
    181 
    182 sub left_dir {
    183   local($pre, $dir, @sdirs) = @_;
    184   local($ok) = (@sdirs == 0);
    185   local(@cdirs) = ();
    186   local($_, $dir0, $d, $qdir, $q, $edir, $e);
    187 
    188   $dir0 = "$dir/";
    189   $dir = "$dir0";
    190   opendir(DIR, "$ROOT$dir") || return;
    191 
    192   foreach(sort readdir(DIR)) {
    193     -d "$ROOT$dir$_" || next;
    194     /^\.$/ && next;
    195     /^\.\.$/ && next;
    196     push(@cdirs, $_);
    197   }
    198   closedir(DIR);
    199 
    200   $qdir = "$ROOT" . &html_quote($dir);
    201   $edir = "$ROOT" . &file_encode($dir);
    202   while(@cdirs) {
    203     $_ = shift @cdirs;
    204     $q = &html_quote($_);
    205     $e = &file_encode($_);
    206     $N++;
    207     if (!$ok && $_ eq $sdirs[0]) {
    208       $d = $dir0 . shift @sdirs;
    209       if (!@sdirs) {
    210         $n = "\" name=\"current";
    211         $SKIPLINE = "\n" x $N;
    212       } else {
    213         $n = '';
    214       }
    215       printf("${pre}o-$AFMT\n", "$edir$e$n", "<b>$q</b>");
    216       &left_dir(@cdirs ? "$pre| " : "$pre  ", $d, @sdirs);
    217       $ok = 1;
    218     } else {
    219       printf("${pre}+-$AFMT\n", "$edir$e", $q);
    220     }
    221   }
    222 }
    223 
    224 sub right_dir {
    225   local($dir) = @_;
    226   local(@list);
    227   local($_, $qdir, $q, $edir, $e, $f, $max, @d, $type, $u, $g);
    228   local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
    229         $atime,$mtime,$ctime,$blksize,$blocks);
    230   local(%sizes, %ctimes, %prints);
    231 
    232   $dir = "$dir/";
    233   opendir(DIR, "$ROOT$dir") || return;
    234 
    235   $qdir = "$ROOT" . &html_quote($dir);
    236   $edir = "$ROOT" . &file_encode($dir);
    237   if ($TYPE eq $TYPE_TREE) {
    238     print "<b>$qdir</b>\n";
    239   }
    240   @list = ();
    241   $max = 0;
    242   foreach(readdir(DIR)) {
    243     /^\.$/ && next;
    244 #    if ($TYPE eq $TYPE_TREE) {
    245 #      /^\.\.$/ && next;
    246 #    }
    247     $f = "$ROOT$dir$_";
    248     (($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
    249       $atime,$mtime,$ctime,$blksize,$blocks) = lstat($f)) || next;
    250     push(@list, $_);
    251     $sizes{$_} = $size;
    252     $ctimes{$_} = $ctime;
    253 
    254     if ($FORMAT eq $FORMAT_COLUMN)  {
    255       if (length($_) > $max) {
    256         $max = length($_);
    257       }
    258       next;
    259     }
    260     $type = &utype($mode);
    261     if ($FORMAT eq $FORMAT_SHORT)  {
    262       $prints{$_} = sprintf("%-6s ", "[$type]");
    263       next;
    264     }
    265     if ($type =~ /^[CB]/) {
    266       $size = sprintf("%3u, %3u", ($rdev >> 8) & 0xff, $rdev & 0xffff00ff);
    267     }
    268     if ($FORMAT eq $FORMAT_LONG) {
    269       $u = $USER{$uid} || ($USER{$uid} = getpwuid($uid) || $uid);
    270       $g = $GROUP{$gid} || ($GROUP{$gid} = getgrgid($gid) || $gid);
    271       $prints{$_} = sprintf( "%s %-8s %-8s %8s %s ",
    272 		&umode($mode), $u, $g, $size, &utime($ctime));
    273 #   } elsif ($FORMAT eq $FORMAT_STANDARD) {
    274     } else {
    275       $prints{$_} = sprintf("%-6s %8s %s ", "[$type]", $size, &utime($ctime));
    276     }
    277   }
    278   closedir(DIR);
    279   if ($SORT eq $SORT_SIZE) { 
    280     @list = sort { $sizes{$b} <=> $sizes{$a} || $a cmp $b } @list;
    281   } elsif ($SORT eq $SORT_TIME) { 
    282     @list = sort { $ctimes{$b} <=> $ctimes{$a} || $a cmp $b } @list;
    283   } else {
    284     @list = sort @list;
    285   }
    286   if ($FORMAT eq $FORMAT_COLUMN) {
    287     local($COLS, $l, $nr, $n);
    288     if ($TYPE eq $TYPE_TREE) {
    289       $COLS = 60;
    290     } else {
    291       $COLS = 80;
    292     }
    293     $l = int($COLS / ($max + 2)) || 1;
    294     $nr = int($#list / $l + 1);
    295     $n = 0;
    296     print "<table>\n<tr valign=top>";
    297     foreach(@list) {
    298       $f = "$ROOT$dir$_";
    299       $q = &html_quote($_);
    300       $e = &file_encode($_);
    301       if ($n % $nr == 0) {
    302         print "<td>";
    303       }
    304       if (-d $f) {
    305         printf($AFMT, "$edir$e", "$q/");
    306       } else {
    307         printf($AFMT, "$edir$e", $q);
    308       }
    309       $n++;
    310       if ($n % $nr == 0) {
    311         print "</td>\n";
    312       } else {
    313         print "<br>\n";
    314       }
    315     }
    316     print "</tr></table>\n";
    317     return;
    318   }
    319   foreach(@list) {
    320     $f = "$ROOT$dir$_";
    321     $q = &html_quote($_);
    322     $e = &file_encode($_);
    323     print $prints{$_};
    324     if (-d $f) {
    325       printf($AFMT, "$edir$e", "$q/");
    326     } else {
    327       printf($AFMT, "$edir$e", $q);
    328     }
    329     if (-l $f) {
    330       print " -> ", &html_quote(readlink($f));
    331     }
    332     print "\n";
    333   }
    334 }
    335 
    336 sub init_option {
    337   local($config) = @_;
    338   $OPT_TYPE   = 0;
    339   $OPT_FORMAT = 1;
    340   $OPT_SORT   = 2;
    341   $TYPE_TREE    = 't';
    342   $TYPE_STANDARD = 'd';
    343   $FORMAT_SHORT    = 's';
    344   $FORMAT_STANDARD = 'd';
    345   $FORMAT_LONG     = 'l';
    346   $FORMAT_COLUMN   = 'c';
    347   $SORT_NAME = 'n';
    348   $SORT_SIZE = 's';
    349   $SORT_TIME = 't';
    350   local(@opt) = ($TYPE_TREE, $FORMAT_STANDARD, $SORT_NAME);
    351   local($_);
    352 
    353   open(CONFIG, "< $config") || return @opt;
    354   while(<CONFIG>) {
    355     chop;
    356     s/^\s+//;
    357     tr/A-Z/a-z/;
    358     if (/^type\s+(\S)/i) {
    359       $opt[$OPT_TYPE] = $1;
    360     } elsif (/^format\s+(\S)/i) {
    361       $opt[$OPT_FORMAT] = $1
    362     } elsif (/^sort\s+(\S)/i) {
    363       $opt[$OPT_SORT] = $1;
    364     }
    365   }
    366   close(CONFIG);
    367   return @opt;
    368 }
    369 
    370 sub update_option {
    371   local($config) = @_;
    372 
    373   open(CONFIG, "> $config") || return;
    374   print CONFIG <<EOF;
    375 type $TYPE
    376 format $FORMAT
    377 sort $SORT
    378 EOF
    379   close(CONFIG); 
    380 }
    381 
    382 sub print_form {
    383   local($d, @OPT) = @_;
    384   local(@disc) = ('Type', 'Format', 'Sort');
    385   local(@val) = (
    386 	"('t', 'd')",
    387 	"('s', 'd', 'c')",
    388 	"('n', 's', 't')",
    389   );
    390   local(@opt) = (
    391 	"('Tree', 'Standard')",
    392 	"('Short', 'Standard', 'Column')",
    393 	"('By Name', 'By Size', 'By Time')"
    394   );
    395   local($_, @vs, @os, $v, $o);
    396 
    397   print <<EOF;
    398 <form method=post action=\"$CGI#current\">
    399 <center>
    400 <table cellpadding=0>
    401 <tr valign=top>
    402 EOF
    403   foreach(0 .. 2) {
    404     print "<td align>&nbsp;$disc[$_]</td>\n";
    405   }
    406   print "</tr><tr>\n";
    407   foreach(0 .. 2) {
    408     print "<td><select name=opt$_>\n";
    409     eval "\@vs = $val[$_]";
    410     eval "\@os = $opt[$_]";
    411     foreach $v (@vs) {
    412       $o = shift(@os);
    413       if ($v eq $OPT[$_]) {
    414         print "<option value=$v selected>$o\n";
    415       } else {
    416         print "<option value=$v>$o\n";
    417       }
    418     }
    419     print "</select></td>\n";
    420   }
    421   print <<EOF;
    422 <td><input type=submit name=cmd value="Update"></td>
    423 </tr>
    424 </table>
    425 </center>
    426 <input type=hidden name=dir value="$d">
    427 <input type=hidden name=cookie value="$local_cookie">
    428 </form>
    429 EOF
    430 }
    431 
    432 sub html_quote {
    433   local($_) = @_;
    434   local(%QUOTE) = (
    435     '<', '&lt;',
    436     '>', '&gt;',
    437     '&', '&amp;',
    438     '"', '&quot;',
    439   );
    440   s/[<>&"]/$QUOTE{$&}/g;
    441   return $_;
    442 }
    443 sub file_encode {
    444   local($_) = @_;
    445   s/[\000-\040\+:#?&%<>"\177-\377]/sprintf('%%%02X', unpack('C', $&))/eg;
    446   return $_;
    447 }
    448 
    449 sub form_decode {
    450   local($_) = @_;
    451   s/\+/ /g;
    452   s/%([\da-f][\da-f])/pack('C', hex($1))/egi;
    453   return $_;
    454 }
    455 
    456 sub cleanup {
    457   local($_) = @_;
    458 
    459   s@//+@/@g;
    460   s@/\./@/@g;
    461   while(m@/\.\./@) {
    462     s@^/(\.\./)+@/@;
    463     s@/[^/]+/\.\./@/@;
    464   }
    465   return $_;
    466 }
    467 
    468 sub utype {
    469   local($_) = @_;
    470   local(%T) = (
    471     0010000, 'PIPE',
    472     0020000, 'CHR',
    473     0040000, 'DIR',
    474     0060000, 'BLK',
    475     0100000, 'FILE',
    476     0120000, 'LINK',
    477     0140000, 'SOCK',
    478   );
    479   return $T{($_ & 0170000)} || 'FILE';
    480 }
    481 
    482 sub umode {
    483   local($_) = @_;
    484   local(%T) = (
    485     0010000, 'p',
    486     0020000, 'c',
    487     0040000, 'd',
    488     0060000, 'b',
    489     0100000, '-',
    490     0120000, 'l',
    491     0140000, 's',
    492   );
    493 
    494   return ($T{($_ & 0170000)} || '-')
    495      . (($_ & 00400) ? 'r' : '-')
    496      . (($_ & 00200) ? 'w' : '-')
    497      . (($_ & 04000) ? 's' :
    498        (($_ & 00100) ? 'x' : '-'))
    499      . (($_ & 00040) ? 'r' : '-')
    500      . (($_ & 00020) ? 'w' : '-')
    501      . (($_ & 02000) ? 's' :
    502        (($_ & 00010) ? 'x' : '-'))
    503      . (($_ & 00004) ? 'r' : '-')
    504      . (($_ & 00002) ? 'w' : '-')
    505      . (($_ & 01000) ? 't' :
    506        (($_ & 00001) ? 'x' : '-'));
    507 }
    508 
    509 sub utime {
    510   local($_) = @_;
    511   local(@MON) = (
    512     'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
    513     'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'
    514   );
    515   local($sec,$min,$hour,$mday,$mon,
    516         $year,$wday,$yday,$isdst) = localtime($_);
    517 
    518   if ($_ > $NOW - 182*24*60*60 && $_ < $NOW + 183*24*60*60) {
    519     return sprintf("%3s %2d %.2d:%.2d", $MON[$mon], $mday, $hour, $min);
    520   } else {
    521     return sprintf("%3s %2d %5d", $MON[$mon], $mday, 1900+$year);
    522   }
    523 }
    524 
    525 sub cygwin_pathconv {
    526   local($_) = @_;
    527   local(*CYGPATH);
    528 
    529   open(CYGPATH, '-|') || exec('cygpath', '-w', $_);
    530   $_ = <CYGPATH>;
    531   close(CYGPATH);
    532   s/\r?\n$//;
    533   s!\\!/!g;
    534   s!/$!!;
    535   return $_;
    536 }
	w3m Unnamed repository; edit this file to name it for gitweb.
	git clone https://logand.com/git/w3m.git/
	Log \| Files \| Refs \| README