w3m

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/w3m.git/
Log | Files | Refs | README

smb.cgi (9491B)


      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 }