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> $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 '<', '<', 436 '>', '>', 437 '&', '&', 438 '"', '"', 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 }