463 lines
		
	
	
		
			9.3 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			463 lines
		
	
	
		
			9.3 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
| #!/usr/bin/perl
 | |
| 
 | |
| # Workgroup list: file:/$LIB/smb.cgi
 | |
| # Server list:    file:/$LIB/smb.cgi?workgroup
 | |
| # Sahre list:     file:/$LIB/smb.cgi?//server
 | |
| #                 file:/$LIB/smb.cgi/server
 | |
| # Directory:      file:/$LIB/smb.cgi?//server/share
 | |
| #                 file:/$LIB/smb.cgi?//server/share/dir...
 | |
| #                 file:/$LIB/smb.cgi/server/share
 | |
| # Get file:       file:/$LIB/smb.cgi?//server/share/dir.../file
 | |
| #                 file:/$LIB/smb.cgi/server/share/dir.../file
 | |
| #
 | |
| # ----- ~/.w3m/smb -----
 | |
| # workgroup = <workgroup>
 | |
| # [ username = <username> ]
 | |
| # [ password = <password> ]
 | |
| # [ password_file = <password_file> ]
 | |
| # ----------------------
 | |
| # --- <password_file> ---
 | |
| # <password>
 | |
| # -----------------------
 | |
| # default:
 | |
| #  <username> = $USER
 | |
| #  <password> = $PASSWD  (Don't use!)
 | |
| #  <password_file> = $PASSWD_FILE
 | |
| 
 | |
| $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"};
 | |
| $PASSWD_FILE = $ENV{"PASSWD_FILE"};
 | |
| &load_auth_file($AUTH_FILE);
 | |
| 
 | |
| $NMBLOOKUP = "nmblookup";
 | |
| $SMBCLIENT = "smbclient";
 | |
| @NMBLOOKUP_OPT = ("-T");
 | |
| @SMBCLIENT_OPT = ("-N");
 | |
| $USE_OPT_A = defined($PASSWD) && (-f $AUTH_FILE) && &check_opt_a();
 | |
| if ($USE_OPT_A) {
 | |
| 	push(@SMBCLIENT_OPT, "-A", $AUTH_FILE);
 | |
| } elsif (-f $PASSWD_FILE) {
 | |
| 	$USE_PASSWD_FILE = 1;
 | |
| } elsif (defined($PASSWD)) {
 | |
| 	$USE_PASSWD_FD = 1;
 | |
| 	$PASSWD_FD = 0;
 | |
| }
 | |
| if (defined($PASSWD)) {
 | |
| 	$passwd = "*" x 8;
 | |
| }
 | |
| $DEBUG && print <<EOF;
 | |
| DEBUG: NMBLOOKUP=$NMBLOOKUP @NMBLOOKUP_OPT
 | |
| DEBUG: SMBCLIENT=$SMBCLIENT @SMBCLIENT_OPT
 | |
| DEBUG: WORKGROUP=$WORKGROUP
 | |
| DEBUG: USER=$USER
 | |
| DEBUG: PASSWD=$passwd
 | |
| DEBUG: PASSWD_FILE=$PASSWD_FILE
 | |
| DEBUG: PASSWD_FD=$PASSWD_FD
 | |
| EOF
 | |
| 
 | |
| $PAGER = "cat";
 | |
| $FILE = "F000";
 | |
| 
 | |
| $CGI = "file://" . &file_encode($ENV{"SCRIPT_NAME"} || $0);
 | |
| $QUERY = $ENV{"QUERY_STRING"};
 | |
| $PATH_INFO = $ENV{"PATH_INFO"};
 | |
| 
 | |
| if ($PATH_INFO =~ m@^/@) {
 | |
| 	$_ = $PATH_INFO;
 | |
| 	if (! m@^//@) {
 | |
| 		$_ = "/$_";
 | |
| 	}
 | |
| 	s@[\r\n\0\\"]@@g;
 | |
| 	$DEBUG && print "DEBUG: PATH_INFO=\"$_\"\n";
 | |
| 	$Q = "";
 | |
| }
 | |
| else {
 | |
| 	$_ = &file_decode($QUERY);
 | |
| 	$DEBUG && print "DEBUG: QUERY_STRING=\"$_\"\n";
 | |
| 	$Q = "?";
 | |
| }
 | |
| if (s@^//([^/]+)@@) {
 | |
| 	$server = $1;
 | |
| #	if (!$USE_OPT_A && !defined($PASSWD)) {
 | |
| #		&print_form("//$server$_");
 | |
| #		exit;
 | |
| #	}
 | |
| 	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$Q$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$Q//$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$Q//"
 | |
| 			. &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>) {
 | |
| 		if (/^\s*$header/) {
 | |
| $DEBUG && print "DEBUG: $_";
 | |
| 			last;
 | |
| 		}
 | |
| 	}
 | |
| 	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";
 | |
| 	$ENV{"USER"} = $USER;
 | |
| 	if ($passwd && !$USE_OPT_A) {
 | |
| 		if ($USE_PASSWD_FILE) {
 | |
| 			$ENV{"PASSWD_FILE"} = $PASSWD_FILE;
 | |
| 		} elsif ($USE_PASSWD_FD) {
 | |
| 			$ENV{"PASSWD_FD"} = $PASSWD_FD;
 | |
| 			if (open(W, "|-")) {
 | |
| 				print W $PASSWD;
 | |
| 				close(W);
 | |
| 				exit;
 | |
| 			}
 | |
| 		}
 | |
| 	}
 | |
| 	open(STDERR, ">/dev/null");
 | |
| 	exec @cmd;
 | |
| 	exit 1;
 | |
| }
 | |
| 
 | |
| sub print_form {
 | |
| 	local($_) = @_;
 | |
| 	local($q) = &html_quote($_);
 | |
| 	$_ = &file_encode($_);
 | |
| 
 | |
| 	print <<EOF;
 | |
| Content-Type: text/html
 | |
| 
 | |
| <h1>$q</h1>
 | |
| <form action="$CGI$Q$_" 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 = $_;
 | |
| 		} elsif (s/^passw(or)?d_file\s*=\s*//i) {
 | |
| 			$PASSWD_FILE = $_;
 | |
| 		}
 | |
| 	}
 | |
| 	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) = (
 | |
| 		'<', '<',
 | |
| 		'>', '>',
 | |
| 		'&', '&',
 | |
| 		'"', '"',
 | |
| 	);
 | |
| 	s/[<>&"]/$QUOTE{$&}/g;
 | |
| 	return $_;
 | |
| }
 |