[w3m-dev 03634] smb.cgi

* Bonus/smb.cgi: added
* Bonus/README: update
From: Hironori SAKAMOTO <hsaka@mth.biglobe.ne.jp>

1 files changed, 397 insertions, 0 deletions

diff --git a/Bonus/smb.cgi b/Bonus/smb.cgi
new file mode 100755
index 0000000..1473d73
--- /dev/null
+++ b/Bonus/smb.cgi
@@ -0,0 +1,397 @@
+#!/usr/bin/perl
+
+# Workgroup list: file:/$LIB/smb.cgi
+# Server list:    file:/$LIB/smb.cgi?workgroup
+# Sahre list:     file:/$LIB/smb.cgi?//server
+# Directory:      file:/$LIB/smb.cgi?//server/share
+#                 file:/$LIB/smb.cgi?//server/share/dir...
+# Get file:       file:/$LIB/smb.cgi?//server/share/dir.../file
+#
+# ----- ~/.w3m/smb -----
+# workgroup = <workgroup>
+# username = <username>
+# password = <password>
+# ----------------------
+
+$DEBUG = 1;
+
+$MIME_TYPE = "~/.mime.types";
+$AUTH_FILE = "~/.w3m/smb";
+$MIME_TYPE =~ s@^~/@$ENV{"HOME"}/@;
+$AUTH_FILE =~ s@^~/@$ENV{"HOME"}/@;
+$WORKGROUP = "-";
+$USER = $ENV{"USER"};
+$PASSWD = $ENV{"PASSWD"};
+&load_auth_file($AUTH_FILE);
+
+$NMBLOOKUP = "nmblookup";
+$SMBCLIENT = "smbclient";
+@NMBLOOKUP_OPT = ("-T");
+@SMBCLIENT_OPT = ("-N");
+$USE_OPT_A = &check_opt_a();
+if ($USE_OPT_A) {
+	undef $USER;
+	undef $PASSWD;
+	push(@SMBCLIENT_OPT, "-A", $AUTH_FILE);
+}
+$PAGER = "cat";
+$FILE = "F000";
+
+$CGI = "file://" . &file_encode($ENV{"SCRIPT_NAME"} || $0);
+$QUERY = $ENV{"QUERY_STRING"};
+
+$_ = &file_decode($QUERY);
+$DEBUG && print "DEBUG: QUERY_STRING=\"$_\"\n";
+if (s@^//([^/]+)@@) {
+	$server = $1;
+	if (s@^/([^/]+)@@) {
+		&file_list("//$server/$1", &cleanup($_));
+	} else {
+		&share_list($server);
+	}
+} elsif (m@^[^/]@) {
+	&server_list($_);
+} else {
+	&group_list();
+}
+
+sub file_list {
+	local($service, $file) = @_;
+	local(@files) = ();
+	local($dir, $qservice, $qfile); 
+	local($_, $c);
+
+$DEBUG && print "DEBUG: service=\"$service\" file=\"$file\"\n";
+	if ($file eq "/") {
+		goto get_list;
+	}
+	$_ = $file;
+	s@/@\\@g;
+	@cmd = ($SMBCLIENT, $service, @SMBCLIENT_OPT, "-c", "ls \"$_\"");
+	$F = &open_pipe(1, @cmd);
+	while (<$F>) {
+$DEBUG && print "DEBUG: $_";
+		/^\s/ && last;
+	}
+	close($F);
+	if (s/\s+([A-Z]*) {1,8}\d+  (\w{3} ){2}[ \d]\d \d\d:\d\d:\d\d \d{4}\s*$//
+		&& $1 !~ /D/) {
+		&get_file($service, $file);
+		exit;
+	}
+
+    get_list:
+	$_ = "$file/*";
+	s@/+@\\@g;
+	@cmd = ($SMBCLIENT, $service, @SMBCLIENT_OPT, "-c", "ls \"$_\"");
+	$F = &open_pipe(1, @cmd);
+	while (<$F>) {
+		/^\s*$/ && last;
+$DEBUG && print "DEBUG: $_";
+		/^cd\s+/ && last;
+		/^\S/ && next;
+		s/\r?\n//;
+		push(@files, $_);
+	}
+	close($F);
+
+	$qservice = &html_quote($service);
+	$service = &file_encode($service);
+	$qfile = &html_quote($file);
+	$file = &file_encode($file);
+
+	print "Content-Type: text/html\n\n";
+	print "<title>$qservice$qfile</title>\n";
+	print "<b>$qservice$qfile</b>\n";
+	print "<pre>\n";
+	for (sort @files) {
+		s/\s+([A-Z]*) {1,8}\d+  (\w{3} ){2}[ \d]\d \d\d:\d\d:\d\d \d{4}\s*$// || next;
+		$c = $&;
+		s/^  //;
+		$_ eq "." && next;
+		print "<a href=\"$CGI?$service"
+			. &cleanup("$file/" . &file_encode($_)) . "\">"
+			. &html_quote($_) . "</a>"
+			. &html_quote($c) . "\n";
+	}
+	print "</pre>\n";
+}
+
+sub get_file {
+	local($service, $file) = @_;
+	local($encoding, $type);
+	local($_, @cmd);
+
+	$_ = $file;
+	s@/@\\@g;
+	@cmd = ($SMBCLIENT, $service, @SMBCLIENT_OPT, "-E", "-c", "more \"$_\"");
+$DEBUG && print "DEBUG: @cmd\n";
+
+	($encoding, $type) = &guess_type($file);
+	$file =~ s@^.*/@@;
+	$| = 1;
+	print "Content-Encoding: $encoding\n" if $encoding;
+	print "Content-Type: $type; name=\"$file\"\n\n";
+
+	$ENV{"PAGER"} = $PAGER if $PAGER;
+	&exec_cmd(1, @cmd);
+}
+
+sub share_list {
+	local($server) = @_;
+	local(@share);
+	local($qserver, $_, $d, @c);
+
+	@share = &get_list(1, $server, "Share");
+
+	$qserver = &html_quote($server);
+	$server = &file_encode($server);
+
+	print "Content-Type: text/html\n\n";
+	print "<title>Share list: $qserver</title>\n";
+	print "<table>\n";
+	print "<tr><td colspan=3><b>$qserver</b>";
+	for (sort @share) {
+		($_, $d, @c) = split(" ");
+		if ($d eq 'Disk') {
+			print "<tr><td>+ <a href=\"$CGI?//$server/"
+				. &file_encode($_) . "\">"
+				. &html_quote($_) . "</a>";
+		} else {
+			print "<tr><td>+ "
+				. &html_quote($_);
+		}
+		print "<td><td>"
+			. &html_quote($d) . "<td><td>"
+			. &html_quote("@c") . "\n";
+	}
+	print "</table>\n";
+}
+
+sub server_list {
+	local($group) = @_;
+	local($master, @server);
+	local($_, @c);
+
+	$master = &get_master($group);
+	@server = &get_list(0, $master, "Server");
+
+	$group = &html_quote($group);
+
+	print "Content-Type: text/html\n\n";
+	print "<title>Server list: $group</title>\n";
+	print "<table>\n";
+	print "<tr><td colspan=3><b>$group</b>\n";
+	for (sort @server) {
+		($_, @c) = split(" ");
+		print "<tr><td>+ <a href=\"$CGI?//"
+			. &file_encode($_) . "\">"
+			. &html_quote($_) . "</a><td><td>"
+			. &html_quote("@c") . "\n";
+	}
+	print "</table>\n";
+}
+
+sub group_list {
+	local($master, @group);
+	local($_, @c);
+
+	$master = &get_master($WORKGROUP || "-");
+	@group = &get_list(0, $master, "Workgroup");
+
+	print "Content-Type: text/html\n\n";
+	print "<title>Workgroup list</title>\n";
+	print "<table>\n";
+	for (sort @group) {
+		($_, @c) = split(" ");
+		print "<tr><td><a href=\"$CGI?"
+			. &file_encode($_) . "\">"
+			. &html_quote($_) . "</a><td><td>"
+			. &html_quote("@c") . "\n";
+	}
+	print "</table>\n";
+}
+
+sub check_opt_a {
+	local($_, $F, @cmd);
+
+	@cmd = ($SMBCLIENT, "-h");
+	$F = &open_pipe(0, @cmd);
+	while (<$F>) {
+		if (/^\s*-A\s/) {
+$DEBUG && print "DEBUG: $_";
+			close($F);
+			return 1;
+		}
+	}
+	close($F);
+	return 0;
+}
+
+sub get_master {
+	local($group) = @_;
+	local($_, $F, @cmd);
+
+	@cmd = ($NMBLOOKUP, "-M", @NMBLOOKUP_OPT, $group);
+	$F = &open_pipe(0, @cmd);
+	$_ = <$F>;
+	$_ = <$F>;
+	close($F);
+	($_) = split(/[,\s]/);
+	s/\.*$//;
+	return $_;
+}
+
+sub get_list {
+	local($passwd, $server, $header) = @_;
+	local(@list) = ();
+	local($_, @cmd, $F);
+
+	@cmd = ($SMBCLIENT, @SMBCLIENT_OPT, "-L", $server);
+	$F = &open_pipe($passwd, @cmd);
+	while (<$F>) {
+		/^\s*$header/ && last;
+	}
+$DEBUG && print "DEBUG: $_";
+	while (<$F>) {
+		/^\s*$/ && last;
+$DEBUG && print "DEBUG: $_";
+		/^\S/ && last;
+		/^\s*-/ && next;
+		push(@list, $_);
+	}
+	close($F);
+	return @list;
+}
+
+sub open_pipe {
+	local($passwd, @cmd) = @_;
+	local($F) = $FILE++;
+
+$DEBUG && print "DEBUG: @cmd\n";
+	open($F, "-|") || &exec_cmd($passwd, @cmd);
+	return $F;
+}
+
+sub exec_cmd {
+	local($passwd, @cmd) = @_;
+
+	$ENV{"LC_ALL"} = "C";
+	if (!$USE_OPT_A && $passwd) {
+		$ENV{"USER"} = $USER if $USER;
+		$ENV{"PASSWD"} = $PASSWD if $PASSWD;
+	}
+	open(STDERR, ">/dev/null");
+	exec @cmd;
+	exit 1;
+}
+
+sub print_form {
+	print <<EOF;
+<form action="$CGI" method=POST>
+<table>
+<tr><td>Workgroup	<td>User	<td>Password
+<tr><td><input type=text size=8 name=group value="$WORKGROUP">
+    <td><input type=text size=8 name=user value="$USER">
+    <td><input type=password size=8 name=passwd value="$PASSWD">
+    <td><input type=submit name=OK value=OK>
+</table>
+</form>
+EOF
+}
+
+sub load_auth_file {
+	local($_) = @_;
+
+	if ($USER =~ s/%(.*)$//) {
+		$PASSWD = $1 unless $PASSWD;
+	}
+	open(F, $_) || return;
+	while (<F>) {
+		s/\s+$//;
+		if (s/^workgroup\s*=\s*//i) {
+			$WORKGROUP = $_;
+		} elsif (s/^user(name)?\s*=\s*//i) {
+			$USER = $_;
+		} elsif (s/^passw(or)?d\s*=\s*//i) {
+			$PASSWD = $_;
+		}
+	}
+	close(F);
+}
+
+sub load_mime_type {
+	local($_) = @_;
+	local(%mime) = ();
+	local($type, @suffix);
+
+	open(F, $_) || return ();
+	while(<F>) {
+		/^#/ && next;
+		chop;
+		(($type, @suffix) = split(" ")) >= 2 || next;
+		for (@suffix) {
+			$mime{$_} = $type;
+		}
+	}
+	close(F);
+	return %mime;
+}
+
+sub guess_type {
+	local($_) = @_;
+	local(%mime) = &load_mime_type($MIME_TYPE);
+	local($encoding) = undef;
+
+	if (s/\.gz$//i) {
+		$encoding = "gzip";
+	} elsif (s/\.Z$//i) {
+		$encoding = "compress";
+	} elsif (s/\.bz2?$//i) {
+		$encoding = "bzip2";
+	}
+	/\.(\w+)$/;
+	$_ = $1;
+	tr/A-Z/a-z/;
+	return ($encoding, $mime{$_} || "text/plain");
+}
+
+sub cleanup {
+	local($_) = @_;
+
+	$_ .= "/";
+	s@//+@/@g;
+	s@/\./@/@g;
+	while(m@/\.\./@) {
+		s@^/(\.\./)+@/@;
+		s@/[^/]+/\.\./@/@;
+	}
+	s@(.)/$@$1@;
+	return $_;
+}
+
+sub file_encode {
+	local($_) = @_;
+	s/[\000-\040\+:#?&%<>"\177-\377]/sprintf('%%%02X', unpack('C', $&))/eg;
+	return $_;
+}
+
+sub file_decode {
+	local($_) = @_;
+	s/\+/ /g;
+	s/%([\da-f][\da-f])/pack('C', hex($1))/egi;
+	s@[\r\n\0\\"]@@g;
+	return $_;
+}
+
+sub html_quote {
+	local($_) = @_;
+	local(%QUOTE) = (
+		'<', '&lt;',
+		'>', '&gt;',
+		'&', '&amp;',
+		'"', '&quot;',
+	);
+	s/[<>&"]/$QUOTE{$&}/g;
+	return $_;
+}