#!/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> ]
# [ 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"};

$_ = &file_decode($QUERY);
$DEBUG && print "DEBUG: QUERY_STRING=\"$_\"\n";
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?$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>) {
		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?$_" 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) = (
		'<', '&lt;',
		'>', '&gt;',
		'&', '&amp;',
		'"', '&quot;',
	);
	s/[<>&"]/$QUOTE{$&}/g;
	return $_;
}