Bonus/smb.cgi

   1 #!/usr/bin/perl
   2
   3 # Workgroup list: file:/$LIB/smb.cgi
   4 # Server list:    file:/$LIB/smb.cgi?workgroup
   5 # Sahre list:     file:/$LIB/smb.cgi?//server
   6 #                 file:/$LIB/smb.cgi/server
   7 # Directory:      file:/$LIB/smb.cgi?//server/share
   8 #                 file:/$LIB/smb.cgi?//server/share/dir...
   9 #                 file:/$LIB/smb.cgi/server/share
  10 # Get file:       file:/$LIB/smb.cgi?//server/share/dir.../file
  11 #                 file:/$LIB/smb.cgi/server/share/dir.../file
  12 #
  13 # ----- ~/.w3m/smb -----
  14 # workgroup = <workgroup>
  15 # [ username = <username> ]
  16 # [ password = <password> ]
  17 # [ password_file = <password_file> ]
  18 # ----------------------
  19 # --- <password_file> ---
  20 # <password>
  21 # -----------------------
  22 # default:
  23 #  <username> = $USER
  24 #  <password> = $PASSWD  (Don't use!)
  25 #  <password_file> = $PASSWD_FILE
  26
  27 $DEBUG = 1;
  28
  29 $MIME_TYPE = "~/.mime.types";
  30 $AUTH_FILE = "~/.w3m/smb";
  31 $MIME_TYPE =~ s@^~/@$ENV{"HOME"}/@;
  32 $AUTH_FILE =~ s@^~/@$ENV{"HOME"}/@;
  33 $WORKGROUP = "-";
  34 $USER = $ENV{"USER"};
  35 $PASSWD = $ENV{"PASSWD"};
  36 $PASSWD_FILE = $ENV{"PASSWD_FILE"};
  37 &load_auth_file($AUTH_FILE);
  38
  39 $NMBLOOKUP = "nmblookup";
  40 $SMBCLIENT = "smbclient";
  41 @NMBLOOKUP_OPT = ("-T");
  42 @SMBCLIENT_OPT = ("-N");
  43 $USE_OPT_A = defined($PASSWD) && (-f $AUTH_FILE) && &check_opt_a();
  44 if ($USE_OPT_A) {
  45         push(@SMBCLIENT_OPT, "-A", $AUTH_FILE);
  46 } elsif (-f $PASSWD_FILE) {
  47         $USE_PASSWD_FILE = 1;
  48 } elsif (defined($PASSWD)) {
  49         $USE_PASSWD_FD = 1;
  50         $PASSWD_FD = 0;
  51 }
  52 if (defined($PASSWD)) {
  53         $passwd = "*" x 8;
  54 }
  55 $DEBUG && print <<EOF;
  56 DEBUG: NMBLOOKUP=$NMBLOOKUP @NMBLOOKUP_OPT
  57 DEBUG: SMBCLIENT=$SMBCLIENT @SMBCLIENT_OPT
  58 DEBUG: WORKGROUP=$WORKGROUP
  59 DEBUG: USER=$USER
  60 DEBUG: PASSWD=$passwd
  61 DEBUG: PASSWD_FILE=$PASSWD_FILE
  62 DEBUG: PASSWD_FD=$PASSWD_FD
  63 EOF
  64
  65 $PAGER = "cat";
  66 $FILE = "F000";
  67
  68 $CGI = "file://" . &file_encode($ENV{"SCRIPT_NAME"} || $0);
  69 $QUERY = $ENV{"QUERY_STRING"};
  70 $PATH_INFO = $ENV{"PATH_INFO"};
  71
  72 if ($PATH_INFO =~ m@^/@) {
  73         $_ = $PATH_INFO;
  74         if (! m@^//@) {
  75                 $_ = "/$_";
  76         }
  77         s@[\r\n\0\\"]@@g;
  78         $DEBUG && print "DEBUG: PATH_INFO=\"$_\"\n";
  79         $Q = "";
  80 }
  81 else {
  82         $_ = &file_decode($QUERY);
  83         $DEBUG && print "DEBUG: QUERY_STRING=\"$_\"\n";
  84         $Q = "?";
  85 }
  86 if (s@^//([^/]+)@@) {
  87         $server = $1;
  88 #       if (!$USE_OPT_A && !defined($PASSWD)) {
  89 #               &print_form("//$server$_");
  90 #               exit;
  91 #       }
  92         if (s@^/([^/]+)@@) {
  93                 &file_list("//$server/$1", &cleanup($_));
  94         } else {
  95                 &share_list($server);
  96         }
  97 } elsif (m@^[^/]@) {
  98         &server_list($_);
  99 } else {
 100         &group_list();
 101 }
 102
 103 sub file_list {
 104         local($service, $file) = @_;
 105         local(@files) = ();
 106         local($dir, $qservice, $qfile);
 107         local($_, $c);
 108
 109 $DEBUG && print "DEBUG: service=\"$service\" file=\"$file\"\n";
 110         if ($file eq "/") {
 111                 goto get_list;
 112         }
 113         $_ = $file;
 114         s@/@\\@g;
 115         @cmd = ($SMBCLIENT, $service, @SMBCLIENT_OPT, "-c", "ls \"$_\"");
 116         $F = &open_pipe(1, @cmd);
 117         while (<$F>) {
 118 $DEBUG && print "DEBUG: $_";
 119                 /^\s/ && last;
 120         }
 121         close($F);
 122         if (s/\s+([A-Z]*) {1,8}\d+  (\w{3} ){2}[ \d]\d \d\d:\d\d:\d\d \d{4}\s*$//
 123                 && $1 !~ /D/) {
 124                 &get_file($service, $file);
 125                 exit;
 126         }
 127
 128     get_list:
 129         $_ = "$file/*";
 130         s@/+@\\@g;
 131         @cmd = ($SMBCLIENT, $service, @SMBCLIENT_OPT, "-c", "ls \"$_\"");
 132         $F = &open_pipe(1, @cmd);
 133         while (<$F>) {
 134                 /^\s*$/ && last;
 135 $DEBUG && print "DEBUG: $_";
 136                 /^cd\s+/ && last;
 137                 /^\S/ && next;
 138                 s/\r?\n//;
 139                 push(@files, $_);
 140         }
 141         close($F);
 142
 143         $qservice = &html_quote($service);
 144         $service = &file_encode($service);
 145         $qfile = &html_quote($file);
 146         $file = &file_encode($file);
 147
 148         print "Content-Type: text/html\n\n";
 149         print "<title>$qservice$qfile</title>\n";
 150         print "<b>$qservice$qfile</b>\n";
 151         print "<pre>\n";
 152         for (sort @files) {
 153                 s/\s+([A-Z]*) {1,8}\d+  (\w{3} ){2}[ \d]\d \d\d:\d\d:\d\d \d{4}\s*$// || next;
 154                 $c = $&;
 155                 s/^  //;
 156                 $_ eq "." && next;
 157                 print "<a href=\"$CGI$Q$service"
 158                         . &cleanup("$file/" . &file_encode($_)) . "\">"
 159                         . &html_quote($_) . "</a>"
 160                         . &html_quote($c) . "\n";
 161         }
 162         print "</pre>\n";
 163 }
 164
 165 sub get_file {
 166         local($service, $file) = @_;
 167         local($encoding, $type);
 168         local($_, @cmd);
 169
 170         $_ = $file;
 171         s@/@\\@g;
 172         @cmd = ($SMBCLIENT, $service, @SMBCLIENT_OPT, "-E", "-c", "more \"$_\"");
 173 $DEBUG && print "DEBUG: @cmd\n";
 174
 175         ($encoding, $type) = &guess_type($file);
 176         $file =~ s@^.*/@@;
 177         $| = 1;
 178         print "Content-Encoding: $encoding\n" if $encoding;
 179         print "Content-Type: $type; name=\"$file\"\n\n";
 180
 181         $ENV{"PAGER"} = $PAGER if $PAGER;
 182         &exec_cmd(1, @cmd);
 183 }
 184
 185 sub share_list {
 186         local($server) = @_;
 187         local(@share);
 188         local($qserver, $_, $d, @c);
 189
 190         @share = &get_list(1, $server, "Share");
 191
 192         $qserver = &html_quote($server);
 193         $server = &file_encode($server);
 194
 195         print "Content-Type: text/html\n\n";
 196         print "<title>Share list: $qserver</title>\n";
 197         print "<table>\n";
 198         print "<tr><td colspan=3><b>$qserver</b>";
 199         for (sort @share) {
 200                 ($_, $d, @c) = split(" ");
 201                 if ($d eq 'Disk') {
 202                         print "<tr><td>+ <a href=\"$CGI$Q//$server/"
 203                                 . &file_encode($_) . "\">"
 204                                 . &html_quote($_) . "</a>";
 205                 } else {
 206                         print "<tr><td>+ "
 207                                 . &html_quote($_);
 208                 }
 209                 print "<td><td>"
 210                         . &html_quote($d) . "<td><td>"
 211                         . &html_quote("@c") . "\n";
 212         }
 213         print "</table>\n";
 214 }
 215
 216 sub server_list {
 217         local($group) = @_;
 218         local($master, @server);
 219         local($_, @c);
 220
 221         $master = &get_master($group);
 222         @server = &get_list(0, $master, "Server");
 223
 224         $group = &html_quote($group);
 225
 226         print "Content-Type: text/html\n\n";
 227         print "<title>Server list: $group</title>\n";
 228         print "<table>\n";
 229         print "<tr><td colspan=3><b>$group</b>\n";
 230         for (sort @server) {
 231                 ($_, @c) = split(" ");
 232                 print "<tr><td>+ <a href=\"$CGI$Q//"
 233                         . &file_encode($_) . "\">"
 234                         . &html_quote($_) . "</a><td><td>"
 235                         . &html_quote("@c") . "\n";
 236         }
 237         print "</table>\n";
 238 }
 239
 240 sub group_list {
 241         local($master, @group);
 242         local($_, @c);
 243
 244         $master = &get_master($WORKGROUP || "-");
 245         @group = &get_list(0, $master, "Workgroup");
 246
 247         print "Content-Type: text/html\n\n";
 248         print "<title>Workgroup list</title>\n";
 249         print "<table>\n";
 250         for (sort @group) {
 251                 ($_, @c) = split(" ");
 252                 print "<tr><td><a href=\"$CGI?"
 253                         . &file_encode($_) . "\">"
 254                         . &html_quote($_) . "</a><td><td>"
 255                         . &html_quote("@c") . "\n";
 256         }
 257         print "</table>\n";
 258 }
 259
 260 sub check_opt_a {
 261         local($_, $F, @cmd);
 262
 263         @cmd = ($SMBCLIENT, "-h");
 264         $F = &open_pipe(0, @cmd);
 265         while (<$F>) {
 266                 if (/^\s*-A\s/) {
 267 $DEBUG && print "DEBUG: $_";
 268                         close($F);
 269                         return 1;
 270                 }
 271         }
 272         close($F);
 273         return 0;
 274 }
 275
 276 sub get_master {
 277         local($group) = @_;
 278         local($_, $F, @cmd);
 279
 280         @cmd = ($NMBLOOKUP, "-M", @NMBLOOKUP_OPT, $group);
 281         $F = &open_pipe(0, @cmd);
 282         $_ = <$F>;
 283         $_ = <$F>;
 284         close($F);
 285         ($_) = split(/[,\s]/);
 286         s/\.*$//;
 287         return $_;
 288 }
 289
 290 sub get_list {
 291         local($passwd, $server, $header) = @_;
 292         local(@list) = ();
 293         local($_, @cmd, $F);
 294
 295         @cmd = ($SMBCLIENT, @SMBCLIENT_OPT, "-L", $server);
 296         $F = &open_pipe($passwd, @cmd);
 297         while (<$F>) {
 298                 if (/^\s*$header/) {
 299 $DEBUG && print "DEBUG: $_";
 300                         last;
 301                 }
 302         }
 303         while (<$F>) {
 304                 /^\s*$/ && last;
 305 $DEBUG && print "DEBUG: $_";
 306                 /^\S/ && last;
 307                 /^\s*-/ && next;
 308                 push(@list, $_);
 309         }
 310         close($F);
 311         return @list;
 312 }
 313
 314 sub open_pipe {
 315         local($passwd, @cmd) = @_;
 316         local($F) = $FILE++;
 317
 318 $DEBUG && print "DEBUG: @cmd\n";
 319         open($F, "-|") || &exec_cmd($passwd, @cmd);
 320         return $F;
 321 }
 322
 323 sub exec_cmd {
 324         local($passwd, @cmd) = @_;
 325
 326         $ENV{"LC_ALL"} = "C";
 327         $ENV{"USER"} = $USER;
 328         if ($passwd && !$USE_OPT_A) {
 329                 if ($USE_PASSWD_FILE) {
 330                         $ENV{"PASSWD_FILE"} = $PASSWD_FILE;
 331                 } elsif ($USE_PASSWD_FD) {
 332                         $ENV{"PASSWD_FD"} = $PASSWD_FD;
 333                         if (open(W, "|-")) {
 334                                 print W $PASSWD;
 335                                 close(W);
 336                                 exit;
 337                         }
 338                 }
 339         }
 340         open(STDERR, ">/dev/null");
 341         exec @cmd;
 342         exit 1;
 343 }
 344
 345 sub print_form {
 346         local($_) = @_;
 347         local($q) = &html_quote($_);
 348         $_ = &file_encode($_);
 349
 350         print <<EOF;
 351 Content-Type: text/html
 352
 353 <h1>$q</h1>
 354 <form action="$CGI$Q$_" method=POST>
 355 <table>
 356 <tr><td>Workgroup       <td>User        <td>Password
 357 <tr><td><input type=text size=8 name=group value="$WORKGROUP">
 358     <td><input type=text size=8 name=user value="$USER">
 359     <td><input type=password size=8 name=passwd value="$PASSWD">
 360     <td><input type=submit name=OK value=OK>
 361 </table>
 362 </form>
 363 EOF
 364 }
 365
 366 sub load_auth_file {
 367         local($_) = @_;
 368
 369         if ($USER =~ s/%(.*)$//) {
 370                 $PASSWD = $1 unless $PASSWD;
 371         }
 372         open(F, $_) || return;
 373         while (<F>) {
 374                 s/\s+$//;
 375                 if (s/^workgroup\s*=\s*//i) {
 376                         $WORKGROUP = $_;
 377                 } elsif (s/^user(name)?\s*=\s*//i) {
 378                         $USER = $_;
 379                 } elsif (s/^passw(or)?d\s*=\s*//i) {
 380                         $PASSWD = $_;
 381                 } elsif (s/^passw(or)?d_file\s*=\s*//i) {
 382                         $PASSWD_FILE = $_;
 383                 }
 384         }
 385         close(F);
 386 }
 387
 388 sub load_mime_type {
 389         local($_) = @_;
 390         local(%mime) = ();
 391         local($type, @suffix);
 392
 393         open(F, $_) || return ();
 394         while(<F>) {
 395                 /^#/ && next;
 396                 chop;
 397                 (($type, @suffix) = split(" ")) >= 2 || next;
 398                 for (@suffix) {
 399                         $mime{$_} = $type;
 400                 }
 401         }
 402         close(F);
 403         return %mime;
 404 }
 405
 406 sub guess_type {
 407         local($_) = @_;
 408         local(%mime) = &load_mime_type($MIME_TYPE);
 409         local($encoding) = undef;
 410
 411         if (s/\.gz$//i) {
 412                 $encoding = "gzip";
 413         } elsif (s/\.Z$//i) {
 414                 $encoding = "compress";
 415         } elsif (s/\.bz2?$//i) {
 416                 $encoding = "bzip2";
 417         }
 418         /\.(\w+)$/;
 419         $_ = $1;
 420         tr/A-Z/a-z/;
 421         return ($encoding, $mime{$_} || "text/plain");
 422 }
 423
 424 sub cleanup {
 425         local($_) = @_;
 426
 427         $_ .= "/";
 428         s@//+@/@g;
 429         s@/\./@/@g;
 430         while(m@/\.\./@) {
 431                 s@^/(\.\./)+@/@;
 432                 s@/[^/]+/\.\./@/@;
 433         }
 434         s@(.)/$@$1@;
 435         return $_;
 436 }
 437
 438 sub file_encode {
 439         local($_) = @_;
 440         s/[\000-\040\+:#?&%<>"\177-\377]/sprintf('%%%02X', unpack('C', $&))/eg;
 441         return $_;
 442 }
 443
 444 sub file_decode {
 445         local($_) = @_;
 446         s/\+/ /g;
 447         s/%([\da-f][\da-f])/pack('C', hex($1))/egi;
 448         s@[\r\n\0\\"]@@g;
 449         return $_;
 450 }
 451
 452 sub html_quote {
 453         local($_) = @_;
 454         local(%QUOTE) = (
 455                 '<', '&lt;',
 456                 '>', '&gt;',
 457                 '&', '&amp;',
 458                 '"', '&quot;',
 459         );
 460         s/[<>&"]/$QUOTE{$&}/g;
 461         return $_;
 462 }