scripts/dirlist.cgi.in

   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 }