#!/usr/bin/perl

############################################################################
# smbgateway (c) copyright 1999 Eric Lammerts <eric@lammerts.org>.
# $Revision: 1.65 $ $Date: 2004/03/22 21:45:30 $

############################################################################
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License, Version 2, as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

############################################################################
# CONFIGURATION

$configfile = $ENV{SMBGATEWAY_CONFIGFILE} || "/etc/smbgateway.conf";
$ENV{PATH} = "/usr/local/bin:/usr/bin:/bin";

############################################################################

use CGI;
use Fcntl ':flock';
use FileHandle;
use Getopt::Std;
use IO::Socket;
use Socket;
use Time::Local;
use LWP::UserAgent;

sub readconfig();
sub execsmbclient(@);
sub opensmbclient(@);
sub encode($);
sub decode($);
sub iplookup($);
sub namelookup($);
sub mimetype($);

# defaults
$conf{smbclient} = "smbclient";
$conf{webname} = "SMB Gateway";

$| = 1;
$SIG{HUP} = 'IGNORE';
$SIG{PIPE} = 'DEFAULT'; # roxen sux

%month2num = (
	"jan" => 0, "feb" => 1, "mar" => 2, "apr" => 3,
	"may" => 4, "jun" => 5, "jul" => 6, "aug" => 7,
	"sep" => 8, "oct" => 9, "nov" => 10, "dec" => 11
);

@cp850_to_latin1_table = (
	0xc7,0xfc,0xe9,0xe2,0xe4,0xe0,0xe5,0xe7,0xea,0xeb,0xe8,0xef,0xee,0xec,0xc4,0xc5,
	0xc9,0xe6,0xc6,0xf4,0xf6,0xf2,0xfb,0xf9,0xff,0xd6,0xdc,0xf8,0xa3,0xd8,0xd7,0x3F,
	0xe1,0xed,0xf3,0xfa,0xf1,0xd1,0xaa,0xba,0xbf,0xae,0xac,0xbd,0xbc,0xa1,0xab,0xbb,
	0x3F,0x3F,0x3F,0x3F,0x3F,0xc1,0xc2,0xc0,0xa9,0x3F,0x3F,0x3F,0x3F,0xa2,0xa5,0x3F,
	0x3F,0x3F,0x3F,0x3F,0x3F,0x3F,0xe3,0xc3,0x3F,0x3F,0x3F,0x3F,0x3F,0x3F,0x3F,0xa4,
	0xf0,0xd0,0xca,0xcb,0xc8,0x3F,0xcd,0xce,0xcf,0x3F,0x3F,0x3F,0x3F,0xa6,0xcc,0x3F,
	0xd3,0xdf,0xd4,0xd2,0xf5,0xd5,0xb5,0xfe,0xde,0xda,0xdb,0xd9,0xfd,0xdd,0xaf,0xb4,
	0xad,0xb1,0x3F,0xbe,0xb6,0xa7,0xf7,0xb8,0xb0,0xa8,0xb7,0xb9,0xb3,0xb2,0x3F,0xa0,
);

############################################################################
# install custom die() handler
############################################################################
$SIG{__DIE__} = sub {
	$out =~ s/<title>Listing of/<title>Error listing/;   #ugly hack
	print <<EOF;
Status: 503 error
Content-Type: text/html

$out
<h1>Error:</h1>
<pre>
$_[0]
</pre>
$footer
EOF
	exit 0;
};

############################################################################
# get config
############################################################################
readconfig;

# renice
if($conf{nice}) { setpriority 0, 0, $conf{nice}; }

# read all known (host,ip) pairs
ipcache_read();

############################################################################
# smbwatch
############################################################################

if($0 =~ /\bsmbwatch$/) {
	$SIG{__DIE__} = 'DEFAULT';
	smbwatch_search();
	exit;
}


############################################################################
# get cgi parameters
############################################################################
my $q = new CGI;
my $parm;
foreach($q->param) { $parm->{$_} = $q->param($_); }

my $sid = $q->cookie('sid') || sprintf("%04x%08x%08x", $$, time, rand 0xffffffff);
$sid =~ s/\W//;	# for security ($sid is used in filenames)
my @cookies = ($q->cookie(-name => 'sid', -value => $sid, -expires => '+14d'));

# legal shit
my $agreed = $parm->{agreed}? 1 : 0;
if($parm->{agreed_set_cookie}) {
	push @cookies, $q->cookie(
		-name => 'agreetoterms',
		-value => $agreed,
		-expires => '+14d',
	);
}
my $htmlheader = $q->header(-cookie => \@cookies);

my $scriptname = $q->script_name;
my $uri = $scriptname . encode($q->path_info);

# check for abuse of username/passwords
if(defined($conf{iplogfile})) {
	if(open F, ">>$conf{iplogfile}") {
		printf F "%s %s %s\n", scalar localtime, $ENV{REMOTE_USER} || '-', $ENV{REMOTE_ADDR};
		close F;
	}
}

############################################################################
# legal shit
############################################################################

my $debugmsg = "";
if($parm->{termsdebug}) {
	$debugmsg .= sprintf <<EOF,
qqq=[%s]<br>
parm->smbhost=[%s]<br>
parm->terms=[%s]<br>
parm->paths=[%s]<br>
agreed=%s<br>
parm->agreed_set_cookie=%s<br>
parm->agreed=%s<br>
cookie=[%s]<br>
EOF
		$q->path_info, $parm->{smbhost}, $parm->{terms}, $parm->{paths},
		$agreed, $parm->{agreed_set_cookie}, $parm->{agreed},
		$q->cookie(-name=>'agreetoterms');
}

if(($parm->{smbhost} || $parm->{terms} || $parm->{paths} || $q->path_info) && !$agreed) {
	die <<EOF;

You must agree to the Terms of Use before you can use $conf{webname}.
Go "back" and read the Terms of Use.
$debugmsg
EOF
}

my $d = scalar localtime ((stat $0)[9]);
$d =~ s/..:..:...//;
$copyright = sprintf <<EOF,
<font size=-1>

Terms of Use: You may NOT use $conf{webname} to download material that is
copyrighted, unless you are the copyright owner or have the permission of
the copyright owner to download it. It is also prohibited to use
$conf{webname} to download material that infringes on any other
intellectual property rights of others or on the privacy or publicity rights
of others.<p>

The author of this software, nor the owner of the hosting server are
responsible for screening or monitoring material downloaded by users. The
owner of the hosting server reserves the right to expel users and prevent
their further access to this software for violating these terms or the
law.<p>
</font>
<br>
<font size=-2>
<!--
%s
%s
%s
-->
</font>
$debugmsg
EOF
	$d, '$Revision: 1.65 $', '$Date: 2004/03/22 21:45:30 $';


############################################################################
# send statusfile if requested
############################################################################
if($parm->{status} && $conf{dlstatusdir}) {
	open F, "$conf{dlstatusdir}/dlstatus_$sid.txt"
		or die "No status file found for this session ($sid)\n";
	print $q->header('text/plain');
	while(<F>) {
		s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g;
		print;
	}
	exit;
}

############################################################################
# redirect to put smbgatewayhost in url
############################################################################
if($parm->{smbhost}) {
	my $args = "?agreed=$parm->{agreed}&agreed_set_cookie=$parm->{agreed_set_cookie}";

	$parm->{smbhost} =~ s~[/\\]+~/~g;
	$parm->{smbhost} =~ s~^/+~~;
	my $path = "";
	$parm->{smbhost} =~ s~(/.*)~~ and $path = $1;
	if($parm->{smbhost} =~ s/\s+\@([-:.0-9a-z]+)//i) {
		$args = "&ip=$1";
		$args =~ s/:(\d+)$/&port=$1/;
	}
	print $q->redirect($q->script_name. "/" . encode("$parm->{smbhost}$path") . "/$args");
	exit;
}

############################################################################
# do search if no host/share/path
############################################################################
if($q->path_info() =~ m|^/*$|) {

	$parm->{maxhits} ||= 500;

	if($parm->{sort} eq "name") { $sortchk_name = "checked"; }
	elsif($parm->{sort} eq "ext") { $sortchk_ext = "checked"; }
	elsif($parm->{sort} eq "size") { $sortchk_size = "checked"; }
	else { $sortchk_path = "checked"; }

	my $agreedchecked = $agreed || ($q->cookie(-name=>'agreetoterms') =~ /1/)?
		"checked":"";
	my $termsdebug;
	$termsdebug = "<input type=hidden name=termsdebug value=1>" if $parm->{termsdebug};

	print <<EOF;
$htmlheader
<html>
<head>
 <title>$conf{webname}</title>
 $conf{extraheader}

<script language="JavaScript"><!-- 
function clearall(form){
   form.smbhost.value = "";
   form.terms.value = "";
   form.terms_not.value = "";
   form.paths.value = "";
   form.paths_not.value = "";
   form.minsize.value = "";
}
function focusterms(){
   document.f.terms.focus();
}
//--></script> 

</head>
<body bgcolor="#ffffff" onLoad=focusterms()>
<h2>$conf{webname}</h2>
<font size=-1>

<form action="$scriptname" method=get name=f>

<table cellspacing=0 cellpadding=4>
<tr><td colspan=4 BGCOLOR="#006666"><font color="#ffffff">Browse:</font></td></tr>

<tr>
 <td BGCOLOR="#CCCCCC" valign=top colspan=4>Windows hostname or IP address:<input type=text name=smbhost size=25></td></tr>
 <tr>
 <td BGCOLOR="#CCCCCC" valign=top colspan=4><font size=-2><pre>Format:</br>
- windows_name[ \@ip_address[:port]][%user:password][/path]
- ip_address[:port][%username:password][/path]
 </pre></font></td></tr>

<tr><td colspan=4>&nbsp;</td></tr>
<tr><td colspan=4 BGCOLOR="#006666"><font color="#ffffff">Search:</font></td></tr>

 <tr>
  <td BGCOLOR="#CCCCCC">Terms:</td>
  <td BGCOLOR="#CCCCCC"><input type=text name=terms value="$parm->{terms}"></td>
  <td BGCOLOR="#CCCCCC">Not:</td>
  <td BGCOLOR="#CCCCCC"><input type=text name=terms_not value="$parm->{terms_not}"></td>
 </tr>
 <tr>
  <td BGCOLOR="#CCCCCC">Paths:</td>
  <td BGCOLOR="#CCCCCC"><input type=text name=paths value="$parm->{paths}"></td>
  <td BGCOLOR="#CCCCCC">Not:</td>
  <td BGCOLOR="#CCCCCC"><input type=text name=paths_not value="$parm->{paths_not}"></td>
 </tr>
 <tr>
  <td BGCOLOR="#CCCCCC">Max. Hits:</td>
  <td BGCOLOR="#CCCCCC"><input type=text name=maxhits value="$parm->{maxhits}"></td>
  <td BGCOLOR="#CCCCCC">Min. Size:</td>
  <td BGCOLOR="#CCCCCC"><input type=text name=minsize value="$parm->{minsize}"></td>
 </tr>
 <tr>
  <td BGCOLOR="#CCCCCC" colspan=4>
   Sort by <input type=radio name=sort value=path $sortchk_path>Path
           <input type=radio name=sort value=name $sortchk_name>Name
           <input type=radio name=sort value=ext $sortchk_ext>Extension
           <input type=radio name=sort value=size $sortchk_size>Size
  </td>
 </tr>
<tr><td colspan=4><br>
 <input type=checkbox name=agreed $agreedchecked> I agree to the Terms of Use (see below). <font size=-2>(A cookie will be set to remember this setting.)</font>
 <input type=hidden name=agreed_set_cookie value=1>
$termsdebug
</td></tr>
<tr>
 <td colspan=2><input type=submit value=Search></td>
 <td colspan=2 align=right><input type=reset value=Clear onClick="javascript:clearall(form); return false;"></td>
</tr>
</table>
</form>
<hr>
EOF

	if($parm->{terms} || $parm->{paths}) {
		search($scriptname);
	}

	printf <<EOF, $copyright;
%s <!-- agreed=$agreed--><!--configfile=$configfile-->
</body>
</html>
EOF
	exit;
}

############################################################################
# get host/share/path/file
############################################################################
$path = $q->path_info();
$path =~ s|^/+||;
$path =~ s|^smb://||;
$path =~ s|^([^/]+)||;
$host = lc($1);
$path =~ s|/*([^/]*)/*|| or die;
$share = $1;
$path =~ s|/*([^/]*)$|| and $file = $1;

$port = $parm->{port} || 139;

$ip = $parm->{ip};

# extract ip if any
if($host =~ s/(^|\@)(\d+\.\d+\.\d+\.\d+(:\d+)?)\b//) {
	$ip = $2;
}

# extract password if any
if($host =~ s/%(.*):(.*)//) {
	$conf{localuser} = uc($1);
	$ENV{PASSWD} = $2;
}

if($ip =~ s/:(\d+)//) {
	$port = $1;
}

# lookup host if only ip address was specified
if($ip && !$host) {
	($host) = namelookup($ip);
	$ipstatus = "$ip => $host";
}

# lookup ip address if we don't have it yet
if($host && !$ip) {
	($ip, $ipstatus) = iplookup($host);
	$ipstatus = "$host => $ip$ipstatus";
}

if($ip) {
	$otherhost = sprintf $otherhosttext, encode($q->path_info);
} else {
	die "$host: no ip address found.\n";
}

############################################################################
# prepare pathname in unc notation
############################################################################
$unc = "//$host";
$unc .= "/$share" if $share;
$unc .= "/$path" if $path;
$unc .= "/$file" if $file;
$unc =~ s|/|\\|g;

#die "tar=$parm->{tar} host=$host share=$share path=$path file=$file ext=$1";

############################################################################
# open status file if we're gonna download something
############################################################################
if($parm->{tar} || $file) {
	if($conf{dlstatusdir}) {
		mkdir $conf{dlstatusdir}, 0700;
		if(open STDERR, ">$conf{dlstatusdir}/dlstatus_$sid.txt") {
			printf STDERR <<EOF,
Status of latest download
=========================

Date:  %s
Host:  %s (ip=%s port=%d)
Share: %s
Path:  %s
File:  %s

EOF
				scalar localtime, $host, $ip, $port, $share, $path, $file;
		} else {
			open STDERR, ">/dev/null";
		}
	} else {
		open STDERR, ">/dev/null";
	}
}
############################################################################
# send tarfile if requested
############################################################################
if($parm->{tar}) {
	my $buf;

	if(open(SMB, "-|") == 0) {
		$file =~ s/\.tar$//;
		$path =~ s|/|\\|g;

		$path or $path = "\\";
		my @prog = ($conf{smbclient}, "\\\\$host\\$share", "-I$ip", "-p$port",
			"-U$conf{localuser}", "-N", "-E", "-D$path", "-nwindows",
			"-thex", "-Tc", "-", $file);
		print STDERR join(" ", @prog) . "\n\n";
		exec @prog;
		exit;
	}
	if(read SMB, $buf, 4096) {
		my $bytes = length($buf);
		my $t = time;
		print "Content-Type: application/x-tar\r\n\r\n$buf";
		$SIG{__DIE__} = 'DEFAULT';
		$SIG{PIPE} = 'IGNORE';
		$SIG{TERM} = sub { die "ERROR: Download aborted (SIGTERM)\n"; };
		$SIG{HUP} = sub { die "ERROR: Download aborted (SIGHUP)\n"; };
		while(read SMB, $buf, 4096) {
			print $buf or die "ERROR: Download aborted (broken pipe)\n";
			$bytes += length($buf);
		}
		$t = time - $t;
		printlog("$bytes bytes, $t sec. (tar).");
	} else {
		die "$unc: File not found (or 0 bytes in size).\n";
	}
	exit;
}

############################################################################
# send file if requested (path is not empty and does not end with a /)
############################################################################
if($file) {
	$file =~ /\.([^.\s]+)$/;
	my $ext = lc($1);
	my $mime = mimetype($ext);

	if(open(SMB, "-|") == 0) {
		$path =~ s|/|\\|g;
		$path or $path = "\\";
		my @prog = ($conf{smbclient}, "\\\\$host\\$share", "-I$ip", "-p$port",
			"-U$conf{localuser}", "-N", "-E", "-D$path", "-nwindows",
			"-thex", "-c", "get \"$file\" -");
		print STDERR join(" ", @prog) . "\n\n";
		exec @prog;
		exit;
	}
	if(read SMB, $buf, 4096) {
		my $bytes = length($buf);
		my $t = time;
		print "Content-Type: $mime\r\n";
		print "Content-Length: $parm->{size}\r\n" if $parm->{size};
		print "\r\n$buf";
		$SIG{__DIE__} = 'DEFAULT';
		$SIG{PIPE} = 'IGNORE';
		$SIG{TERM} = sub { die "ERROR: Download aborted (SIGTERM)\n"; };
		$SIG{HUP} = sub { die "ERROR: Download aborted (SIGHUP)\n"; };
		while(read SMB, $buf, 4096) {
			print $buf or die "ERROR: Download aborted (broken pipe)\n";
			$bytes += length($buf);
		}
		$t = time - $t;
		printlog("$bytes bytes, $t sec. (file, $ext).");
	} else {
		if(defined($parm->{size}) && $parm->{size} == 0) {
			print "Content-Type: $mime\r\n";
			print "Content-Length: 0\r\n";
			print "\r\n";
		} else {
			die "$unc: File not found or zero-length.\n";
		}
	}
	exit;
}

############################################################################
# all other stuff outputs html so print a header now
############################################################################
$out = <<EOF;
<html>
<head>
 <title>Listing of $unc</title>
 $conf{extraheader}
</head>

<body bgcolor="#ffffff">
<font size=+3>
 <b>Listing of $unc</b>
</font>
<br>

[<a href="$scriptname">search</a>]
<font size=-2>
 <i><pre>$ipstatus</pre></i>
</font>

<font size=-1>
<pre>
EOF

$footer = <<EOF;
</pre>
<hr>
$copyright
</body>
</html>
EOF

############################################################################
# print the shares of a host
############################################################################
if(!$share) {
	local *SMB;
	opensmbclient "-L$host", "-I$ip", "-U$conf{localuser}", "-N",
		"-p$port", "-s/dev/null";
	MAIN: while(<SMB>) {
		next if /^added interface /;
		if(/^\s+Sharename\s+Type\s+Comment\s*$/) {
			$out .= <<EOF;
<b>Share           Comment</b>
EOF
			$_ = <SMB>;
			while(<SMB>) {
				last MAIN unless /\S/;
				/^\s+(.{0,13}\S)\s+(\S+)\s+(.*\S)?/ and $2 eq "Disk" and
#die "uri=$uri 1=$1";
					$out .= sprintf qq|<a href="%s%s?agreed=$agreed&ip=%s">%-19s %s\n|,
						$uri, encode("$1/"), $ip, "$1</a>", $3;
			}
		} else {
			$out .= $_;
		}
	}

	# read and discard rest of output. If we don't do this, we lose the exit
	# status when smbclient gets a SIGPIPE.
	1 while <SMB>;

	close SMB or die <<EOF;
smbclient returned non-zero exit status.<br>\n
$otherhost
EOF

############################################################################
# print a directory listing
############################################################################
} else {
	my ($p, $name_r, $ext_r, $size_r, $date_r, $uppath, $tarpath, $sort);
	($p = $path) =~ s|/|\\|g;
	$p or $p = "\\";
	my $badpath = '';

	opensmbclient "\\\\$host\\$share", "-I$ip", "-p$port",
		"-U$conf{localuser}", "-N", "-D$p", "-c",
		qq|begin_listing_ls;ls|, "-s/dev/null";
	while(<SMB>) {
		next if /^added interface /;
		last if /^begin_listing_ls/;
		s~(.*(ERRbadpath|NT_STATUS_).*)~<b>$1</b>~
			and $badpath = "$1\n";
		$out .= $_;
	}

	$name_r = 'r' if $parm->{s} eq 'n';
	$ext_r = 'r' if $parm->{s} eq 'e';
	$size_r = 'r' if $parm->{s} eq 's';
	$date_r = 'r' if $parm->{s} eq 'd';
	($uppath = $uri) =~ s|[^/]*/$||;
	($tarpath = $uri) =~ s|/+$|.tar|;

	($host_esc = $host) =~ s/'/'\\''/g;
	($share_esc = $share) =~ s/'/'\\''/g;
	($path_esc = $path) =~ s/'/'\\''/g;
	
	$out .= <<EOF;
<i>$conf{smbclient} '//$host_esc/$share_esc' -I $ip -D '$path_esc' -p$port -N -UGUEST</i>
</pre>
</font>
<font>
<pre><a href="$uppath?agreed=$agreed&s=$parm->{s}&ip=$ip">Up to higher-level directory</a>            Download <a href="$tarpath?agreed=$agreed&tar=y&ip=$ip">tar</a> of this directory (<a href="$scriptname?agreed=$agreed&status=y">status</a>)

EOF
	$badpath and die $badpath;
	$out .= <<EOF;
  <a href=\"$uri?agreed=$agreed&s=n$name_r&ip=$ip\">Filename</a>_(<a href=\"$uri?agreed=$agreed&s=e$ext_r\&ip=$ip">Ext</a>)_______________________________ ____<a href=\"$uri?agreed=$agreed&s=s$size_r&ip=$ip\">Size</a>  <a href=\"$uri?agreed=$agreed&s=d$date_r&ip=$ip\">Date</a>_________________
EOF
	while(<SMB>) {
		/^\s*(.*\S)\s+([ A-Z]+)([ \d]{7,12}\d)\s+(\w\w\w \w\w\w [ \d]\d \d\d:\d\d):\d\d (\d\d\d\d)\s*$/ or last;
		my ($file, $isdir, $size, $date) = ($1, $2, $3, "$4 $5");
		next if $file =~ /^\.\.?$/;
#		$out .= "--$file--$isdir--$size--$date--" . length($size) . "\n";
		$file =~ s/:(\w\w)/chr(hex($1))/eig;
#		$out .= "--$file--$isdir--$size--$date--" . length($size) . "\n";
		$allfilenames .= $file;
		$size =~ s/ +//g;
		my $link;
		if($isdir =~ /D/) {
			$link = $uri . encode($file) . "/?agreed=$agreed&s=" . $parm->{s} . "&ip=$ip";
			$size = "";
			$encfile = encode($file);
			$p = encode($q->path_info());
			$tar = qq|<a href="$scriptname$p$encfile.tar?agreed=$agreed&tar=y&ip=$ip">D</a>|;
		} else {
			$link = $uri . encode($file) . "?agreed=$agreed&ip=$ip&size=$size";
			$tar = " ";
		}
		$maxlen = 53 - length($size);
		$space = length($file) > $maxlen? "\n  " . " "x$maxlen : " "x($maxlen-length($file));
		$ext = "";
		if($file =~ /\.([^.\s]+)$/i and $ext = ${"link_" . lc($1)}) {
			my $unc2;

			($unc2 = $unc) =~ s|\\|/|g;
			$unc2 =~ s|/*$|/|;
			$unc2 .= $file;
			$unc2 = encode($unc2);
			$ext =~ s/%s/$unc2/eg;
		}
		$files{$file} = qq|$tar <a href="$link">$file</a>$space $size  $date$ext\n|;
		if($parm->{s} =~ /s/) {
			$sort = sprintf "%10d", $size;
		} elsif($parm->{s} =~ /e/) {
			($sort = lc($file)) =~ s/.*\.// or $sort = "";
		} elsif($parm->{s} =~ /d/) {
			$date =~ /\w\w\w (\w\w\w) ([ \d]\d) (\d\d):(\d\d) (\d\d\d\d)/;
			$sort = sprintf "%10d", timelocal(0,$4,$3,$2,$month2num{lc($1)},$5);
		} else {
			$sort = lc($file);
		}
		$sort{$file} = (($isdir =~ /D/ xor $parm->{s} =~ /r/)? '1':'2') . $sort;
#		$out .= "==$file=>$sort{$file}\n";
	}
	if($parm->{s} =~ /r/) {
		foreach(sort { $sort{$b} cmp $sort{$a} || $b cmp $a } keys %files) { $out .= $files{$_}; }
	} else {
		foreach(sort { $sort{$a} cmp $sort{$b} || $a cmp $b } keys %files) { $out .= $files{$_}; }
	}
	close SMB or die <<EOF;
smbclient returned non-zero exit status.<br>\n
$otherhost
EOF
}

############################################################################
# print html footer
############################################################################

# convert cp850->latin1, unless it's latin1 already
# we assume it's latin1 if the number of chars in the 0xc0-0xff range
# is bigger than the number of chars in the 0x80-0xbf range
(my $l = $allfilenames) =~ s/([^\x80-\xbf])//g;
(my $u = $allfilenames) =~ s/([^\xc0-\xff])//g;

$out =~ s/([\x80-\xff])/chr($cp850_to_latin1_table[ord($1)-0x80])/eig
	if length($l) > length($u);

print $htmlheader;
print $out;
printf "<!--cp850:%d latin1:%d-->\n", length($l), length($u);
print $footer;

#############################################################################
#############################################################################

sub readconfig() {
	local *F;

	open F, $configfile or die "$configfile: $!\n";
	while(<F>) {
		s/(#.*)?\s*$//;
		next unless /./;
		/^\s*(\w+)\s*=\s*(.*\S)/ or die "$configfile line $.: invalid format\n";
		$conf{$1} = $2;
	}
	close F;
}

sub execsmbclient(@) {
	$parm->{smbdebug} and die "smbclient '" . join("' '", @_) . "'\n";
	open STDERR, ">/dev/null";
#	exec 'strace', '-o/tmp/smbclient.strace',$conf{smbclient}, @_;
	exec $conf{smbclient}, @_, "-nwindows", "-thex";
}

sub opensmbclient(@) {
	if(open(SMB, "-|") == 0) {
		execsmbclient @_;
		die "$conf{smbclient}: $!\n";
	}
}

sub encodeplus($) {
	my ($a) = @_;

	$a =~ s|([^- ./\w])|sprintf "%%%02x", ord($1)|ge;
	$a =~ s| |+|g;
	$a;
}

sub encode($) {
	my ($a) = @_;

	$a =~ s|([^-./\w])|sprintf "%%%02x", ord($1)|ge;
#	$a =~ s| |+|g;
	$a;
}

sub decode($) {
	my ($a) = @_;

	$a =~ s|&nbsp;| |g;
	$a =~ s|&#(\d+);|chr $1|eg;
	$a =~ s|&lt;|<|g;
	$a =~ s|&gt;|>|g;
	$a =~ s|&amp;|&|g;
	$a;
}

sub printlog($) {
	$logfile or return;
	my $a = $ENV{REMOTE_ADDR};
	my $location = "ext";

	if($a =~ /^10\./ || $a eq "130.89.30.50") {
		$location = "sk ";
	} elsif($a =~ /^130\.89\./) {
		$location = "ut ";
	}

	if(open F, ">>$logfile") {
		printf F "%s %s %s\n", scalar localtime, $location, $_[0];
		close F;
	}
}

sub iplookup_dcse($) {
	my ($name) = @_;
	my $ip;
	my $sock = IO::Socket::INET->new(
		PeerAddr => $conf{dcse_host},
		PeerPort => $conf{dcse_port}
	) or return undef;

	dcse_readycmd($sock, '') or return undef;
	dcse_readycmd($sock, "SET FIELDS_STATUS=\n") or return undef;
	dcse_readycmd($sock, "SET FIELDS_COMPUTER=IP,NAME\n") or return undef;
	dcse_readycmd($sock, "SET TYPE=c\n") or return undef;
	dcse_readycmd($sock, "SET TERM=$name\n") or return undef;

	print $sock "SEARCH\n";
	while ($_ = $sock->getline()) {
		s/\s+$//;
		$_ eq "READY" and last;
		s/^([^|]+)\|// or next;

		if($1 eq "C") {
			my ($ip2, $comp) = split /\|/, $_;
			$ip = $ip2 if lc($comp) eq $name;
		}
	}
	print $sock "QUIT\n";
	close $sock;
	return $ip;
}

sub iplookup_tcp($) {
	my $ip = undef;
	local *LOOKUP;

	my $l_ip = inet_aton($iplookup_host)
		or die "$iplookup_host: $!\n";

	socket(LOOKUP, PF_INET, SOCK_STREAM, getprotobyname('tcp')) or die;
	connect LOOKUP, sockaddr_in($iplookup_port, $l_ip)
		or die "$iplookup_host: $!\n";
	print LOOKUP "$_[0]\n";
	autoflush LOOKUP 1;
	shutdown LOOKUP, 1;	# send EOF
	while(<LOOKUP>) {
		if(/^(\d+\.\d+\.\d+\.\d+)/) {
			$ip = $1;
			last unless $ip =~ /192\.168\./;
		}
	}
	close LOOKUP;
	$ip;
}

sub iplookup_wins($) {
	foreach(split /\s+/, $conf{wins_host}) {
		local *F;
		if(open(F, "-|") == 0) {
			open STDERR, ">/dev/null";
			exec "nmblookup", "-R", "-U", $_, $_[0];
			exit;
		}
		while(<F>) {
			my $ip = undef;
			/^(\d+\.\d+\.\d+\.\d+)\s+(.*)<00>\s*$/ or next;
			$2 eq $_[0] or next;
			$_ = $1;
			if(/$conf{wins_match}/) {
				close F;
				return $_;
			}
		}			
		close F;
	}
	return undef;
}

sub ipcache_read($) {
	local *F;
	my $m = time - $conf{ipcache_maxage};

	open F, $conf{ipcache_file} or return undef; #die "$conf{ipcache_file}: $!\n";
	flock F, LOCK_SH or die "flock $conf{ipcache_file}: $!\n";
	while(<F>) {
		my ($h, $ip, $t) = split /\t+/, $_;
		#warn "(host,ip,time)=($h,$ip,$t)\n";
		if($t >= $m) {
			$ipcache{lc($h)} = $ip;
		} else {
			$ipcache_old{lc($h)} = $ip;
		}
	}
	flock F, LOCK_UN;
	close F;
}

sub ipcache_update($$) {
	local *F;
	my ($host, $ip) = @_;
	my ($h, $i, $t, $newfile);

	$host = lc($host);
	open F, "+<$conf{ipcache_file}" or return; #die "$conf{ipcache_file}: $!\n";
	flock F, LOCK_EX or die "flock $conf{ipcache_file}: $!\n";
	while(<F>) {
		$newfile .= $_ unless /^$host\t/i;
	}
	$newfile .= sprintf "%s\t%s\t%d\n", lc($host), $ip, time;
	seek F, 0, 0;
	print F $newfile;
	truncate F, tell(F);
	flock F, LOCK_UN;
	close F;
	$ipcache{$host} = $ip;
}

sub iplookup($) {
	my $ip;
	my $host = lc($_[0]);

	$ip = $ipcache{$host} and return ($ipcache{$host}, ' (cached)');

#	$ip = iplookup_tcp($host);
	if($ip = iplookup_wins($host)) {
		ipcache_update($host, $ip);
		return ($ip, ' (wins)');
	} elsif($ip = iplookup_dcse($host)) {
		ipcache_update($host, $ip);
		return ($ip, ' (dance)');
	} else {
		$ipcache_old{$host} or die "Cannot find ip for '$host'\n";
		return ($ipcache{$host}, ' (cached, old)');
	}
}

sub namelookup($) {
	local *N;

	open N, "nmblookup -A $_[0] |";
	while(<N>) {
		/^\s*([^<]*[^<\s])\s*<(\w\w)>/ or next;
		if($2 eq "03" || $2 eq "20") {
			close N;
			return (lc($1), $2);
		}
	}
	close N;
	die "hostname not found!\n";
}

sub mimetype($) {
	local *MIME;

	$conf{"mimetype_$_[0]"} and return $conf{"mimetype_$_[0]"};
	$conf{lc "mimetype_$_[0]"} and return $conf{lc "mimetype_$_[0]"};

	open MIME, $conf{mimetypes_file} or die "$conf{mimetypes_file}: $!\n";
	while(<MIME>) {
		my ($mime, @exts) = split /\s+/;
		foreach(@exts) {
			if($_ eq $_[0]) {
				close MIME;
				return $mime;
			}
		}
	}
	close MIME;
	return $conf{default_mimetype} || "text/plain";
}

sub formatsize($) {
	my ($size) = @_;

	if($size > 10*1024*1024) {
		return sprintf "%dM", ($size + 512*1024) / 1024 / 1024;
	} elsif($size > 10*1024) {
		return sprintf "%dk", ($size + 512) / 1024;
	} else {
		return $size;
	}
}

sub dcse_readycmd {
	my ($sock, $cmd) = @_;
	my $line;

#	print "<pre>C $cmd</pre>\n";
	print $sock $cmd;
	while ($_ = $sock->getline()) {
		chomp;
#		print "<pre>R $cmd</pre>\n";
		return 1 if $_ eq "READY";
		return undef if /^F\|(.*)/;
	}
}

sub dcse_search($$$) {
	my ($terms, $res, $found) = @_;
	my %keys = (
		"minsize"   => "MINSIZE",
		"maxsize"   => "MAXSIZE",
		"maxhits"   => "MAX",
		"terms"     => "TERM",
		"terms_not" => "TERM_NOT",
		"paths"     => "PATH",
		"paths_not" => "PATH_NOT",
		"type"      => "TYPE",
	);

	$conf{dcse_host} or return;
	$conf{dcse_port} ||= 28800;
	my $sock = IO::Socket::INET->new(
		PeerAddr => $conf{dcse_host},
		PeerPort => $conf{dcse_port}
	) or return undef;

	dcse_readycmd($sock, '') or return undef;
	dcse_readycmd($sock, "SET FIELDS_STATUS=\n") or return undef;
	dcse_readycmd($sock, "SET FIELDS_RESULT=CID,TYPE,SIZE,PATH\n") or return undef;
	dcse_readycmd($sock, "SET FIELDS_COMPUTER=CID,IP,NAME\n") or return undef;
	dcse_readycmd($sock, "SET MODE=SMART\n") or return undef;
	dcse_readycmd($sock, "SET CLIENT=VIND\n") or return undef;
	foreach(keys %keys) {
		if($terms->{$_}) {
			dcse_readycmd($sock, "SET $keys{$_}=$terms->{$_}\n") or return undef;
		}
	}

	my $line;
	my %comp;
	my %ip;
	my %filename;
	$found->{Dance} = 0;
	print $sock "SEARCH\n";
	while ($_ = $sock->getline()) {
		s/\s+$//;
		$_ eq "READY" and last;
		s/^([^|]+)\|// or next;

#		print "<pre>S :$1:$_:</pre>\n";
		if($1 eq "C") {
			my ($cid, $ip, $comp) = split /\|/, $_;
			$ip{$cid} = $ip;
			$comp{$cid} = lc($comp);
			ipcache_update($comp, $ip) unless $ipcache{lc($comp)};
		} elsif($1 eq "R") {
#			print "<pre>LINE $_</pre>\n";
			my ($cid, $type, $size, $path) = split /\|/, $_;
			$path =~ s|^/+||;
			$path =~ s|\\|/|g;
			$path =~ s/\s+$//;
			$path = "$comp{$cid}/$path";
			$path .= "/" if lc($type) ne "file";
			my $key = lc($path);

			$found->{Dance}++;
			if(exists $res->{$key}) {
				# already got a result from other search engine
				$res->{$key}->{se} .= "+Dance";
				next;
			}
			$res->{$key}->{path} = $path;
			$res->{$key}->{se} = "Dance";
			$res->{$key}->{size} = $size;
		}
	}
	print $sock "QUIT\n";
	close $sock;
	return 1;
}

sub swing_search($$$) {
	my ($terms, $res, $found) = @_;

	$conf{swing_url} or return;
	my $url = "$conf{swing_url}?halfcollapse=on&shortpaths=on&useips=on&sendform=advanced&swingbutton=Search%21";
	if($terms->{minsize})   { $url .= "&minsize=$terms->{minsize}"; }
	if($terms->{maxsize})   { $url .= "&maxsize=$terms->{maxsize}"; }
	if($terms->{maxhits})   { $url .= "&number=$terms->{maxhits}"; }
	if($terms->{terms})     { $url .= "&query=" . encode($terms->{terms}); }
	if($terms->{terms_not}) { $url .= "&not=" . encode($terms->{terms_not}); }
	if($terms->{paths})     { $url .= "&path=" . encode($terms->{paths}); }

	my $ua = new LWP::UserAgent;
	$ua->agent('Mozilla/4.77 [en] (X11; I; Linux 2.4.19 i686)');
	if($conf{swing_timeout}) { $ua->timeout($conf{swing_timeout}); }

	my $swreq = HTTP::Request->new(GET => $url);
	my $swres = $ua->request($swreq);

	$swres->code == 200 or return undef;

	my $dir = 0;
	my %ipseen;
	$found->{Swing} = 0;
	foreach(split /\n/, $swres->content) {
		###my $a = $_; $a =~ s/</&lt;/g; $a =~ s/>/&gt;/g; printf "<PRE>LINE: %s</PRE>\n", $a;
		m~/diricon\.gif~i and $dir = 1;
		m~<NOBR>\s*(\d+)\s*</NOBR>
		  .*<A\s+CLASS=sl\s+HREF="(smb://|\\\\)(\d+\.\d+\.\d+\.\d+)">([^<]+)</A>
		  .*<A\s+CLASS=sl\s+HREF="(smb://|\\\\)\d+\.\d+\.\d+\.\d+(/|\\)([^"]+)">~ix or next;

		my ($size, $ip, $host, $path) = ($1, $3, decode(lc($4)), decode($7));
		#print "<pre>($size, $ip, $host, $path)</pre>\n";

		ipcache_update($host, $ip) unless $ipcache{$host};
			
		$path =~ s|\\|/|g;
		$path =~ s|^/+||;
		$path =~ s/\s+$//;
		$path = "$host/$path";
		if($dir) {
			next if $terms->{type} eq "file";
			$path .= "/";
		}
		my $key = lc($path);

		$found->{Swing}++;
		if(exists $res->{$key}) {
			# already got a result from other search engine
			$res->{$key}->{se} .= "+Swing";
			next;
		}
		$res->{$key}->{path} = $path;
		$res->{$key}->{se} = "Swing";
		$res->{$key}->{size} = $size;

		$dir = 0;
	}
	return 1;
}

sub infofind_search($$$) {
	my ($terms, $res, $found) = @_;

	$conf{infofind_url} or return;

	my $ua = new LWP::UserAgent;
	$ua->agent('Mozilla/4.77 [en] (X11; I; Linux 2.4.19 i686)');
	if($conf{infofind_timeout}) { $ua->timeout($conf{infofind_timeout}); }

	$found->{Infofind} = 0;

	my $url = sprintf "%s?mode=advanced&Submit=%3A%3A+Search+%3A%3A" .
	                  "&min_size=%s&max_size=%s&max_res=%s&max_cres=%s" .
	                  "&pos_terms=%s&neg_terms=%s&dir_pos=%s&dir_neg=%s",
		$conf{infofind_url}, $terms->{minsize}, $terms->{maxsize},
		$terms->{maxhits}, $terms->{maxhits},
		encode($terms->{terms}), encode($terms->{terms_not}),
		encode($terms->{paths}), encode($terms->{paths_not}),
	#print "<!--infofind url=$url -->\n";

	# Infofind doesn't tell us whether the hit is a directory or not, 
	# so we do two searches, one with "only dir" on (so every hit must be a dir)
	# and one with "only dir" off. The results of the first search are only
	# used to determine what the results mean in the second search.
	my %hit_is_dir;
	foreach my $pass (0..1) {
		#print "\n<!--infofind pass=$pass -->\n";

		my $swreq = HTTP::Request->new(GET => $url . ($pass == 0? "&onlydir=on" : ""));
		my $swres = $ua->request($swreq);

		$swres->code == 200 or return undef;

		foreach(split /\n/, $swres->content) {
#			my $a = $_; $a =~ s/</&lt;/g; $a =~ s/>/&gt;/g; printf "<PRE>LINE: %s</PRE>\n", $a if $a =~ /href/i;

			my ($host, $path, $size);
			while(s~<a\s+href="file://///  ([^"/]+)  /  ([^"]+)"~~ix) {
				($host, $path) = (lc($1), $2);
			}
			$host && $path or next;
			m~([\d.]+)([KMG]?)B</td>~ix or next;
			#print "<!--infofind size=$1$2 host=$host path=$path -->\n";
			$size = $1;
			if($2 eq "K") { $size *= 1024; }
			elsif($2 eq "M") { $size *= 1024 * 1024; }
			elsif($2 eq "G") { $size *= 1024 * 1024 * 1024; }

			$path =~ s|\\|/|g;
			$path =~ s|^/+||;
			$path =~ s/\s+$//;
			$path = "$host/$path";
			if($pass == 0) {
				$hit_is_dir{$path} = 1;
				next;
			}
			if($hit_is_dir{$path}) {
				next if $terms->{type} eq "file";
				$path .= "/" 
			}

			my $key = lc($path);

			$found->{Infofind}++;
			if(exists $res->{$key}) {
				# already got a result from other search engine
				$res->{$key}->{se} .= "+Infofind";
				next;
			}
			$res->{$key}->{path} = $path;
			$res->{$key}->{se} = "Infofind";
			$res->{$key}->{size} = $size;
		}
	}
	return 1;
}

sub remove_search_dups($$$) {
	my ($res, $found, $dups) = @_;

	foreach(keys %$res) {
		m|(.*/)[^/]+$| or next;
		my $se = $res->{$_}->{se};
		for(my $p = $1; $p ne ""; $p =~ s|[^/]+/+$||) {
			if($res->{$p} && !$dups) {
				# delete file results if dir is included
				delete $res->{$_};
				foreach(split /\+/, $se) { $found->{$_}--; }
				last;
			}
		}
	}
}

sub print_search_results($$$;$) {
	my ($res, $found, $sort, $scriptname) = @_;

	print <<EOF if $scriptname;
<table cellpadding=2>
 <tr>
  <th align=right>Size</th>
  <th align=left>Filename</th>
  <th align=left></th>
  <th align=left>Path</th>
 </tr>
EOF
	my @k;
	if($sort eq "path") {
		@k = sort { lc($a) cmp lc($b) } keys %$res;
	} elsif($sort eq "name") {
		my %mangled;
		foreach(keys %$res) {
			$mangled{$_} = lc($_);		#lowercase
			$mangled{$_} =~ s|.*/||;	#strip path (dirs: name=empty!)
			$mangled{$_} =~ s/[^a-z]+/ /g;	#replace non-alpha char sequences by single space
			$mangled{$_} =~ s/^ | $//g;	#remove space at begin & end
		}
		@k = sort { $mangled{$a} cmp $mangled{$b} || lc($a) cmp lc($b) } keys %mangled;
	} elsif($sort eq "size") {
		@k = sort { $res->{$a}->{size} <=> $res->{$b}->{size} } keys %$res;
	} elsif($sort eq "ext") {
		my %ext;
		foreach(keys %$res) {
			m|\.([^./]*)$| and $ext{$_} = lc($1);
		}
		@k = sort { $ext{$a} cmp $ext{$b} } keys %$res;
	} else {
		@k = keys %$res;
	}
	my $noping = 0;
	foreach(@k) {
		my $encpath = "";
		my $pathlink = "//";
		my $namelink = "";
		my $size = $res->{$_}->{size};
		my $se = $res->{$_}->{se};
		my $path = $res->{$_}->{path};
		$path =~ m~^([^/]*)~; # hostname in $1
		my $ip = $ipcache{$1};
		while($path =~ s|([^/]+)/+||) {
			my $p = $1;
			$encpath .= encode($p) . "/";
			$p =~ s/ /&nbsp;/g;
			$pathlink .= sprintf '<a href="%s/%s?agreed=%d&ip=%s&se=%s">%s</a>/',
				$scriptname, $encpath, $agreed, $ip, $se, $p;
		}
		if($path ne "") {
			$encpath .= encode($path);
			$path =~ s/ /&nbsp;/g;
			$namelink = sprintf '<a href="%s/%s?agreed=%d&ip=%s&se=%s&size=%d">%s</a>',
				$scriptname, $encpath, $agreed, $ip, $se, $size, $path;
		}
		if($scriptname) {
			printf <<EOF, formatsize($size), $namelink, ($dead{$ip}? "&times;":""), $pathlink;
 <tr>
  <td align=right>%s&nbsp;</td>
  <td align=left>%s&nbsp;</td>
  <td align=left>%s</td>
  <td align=left>%s</td>
 </tr>
EOF
			if($dead{$ip}) {
				$noping = 1;
			}
		} else {
			$res->{$_}->{path} =~ m|(.*)/(.*)|;
			printf "%-5s %-30s %s (%s)\n", formatsize($size), $2, $1, $se;
		}
	}
	printf <<EOF,
</table>
<br>
%d hits (%s+%s+%s).%s
<br>
<hr>
EOF
		scalar @k, $found->{Dance}, $found->{Swing}, $found->{Infofind},
		$noping? "\n<br>(&times;: no ping)\n" : "",
		if $scriptname;
	return scalar @k > 0;
}

sub filter_search_results($$) {
	my ($res, $found) = @_;

	foreach(keys %$res) {
		my $path = $res->{$_}->{path};
		my $size = $res->{$_}->{size};
		my $type = $path =~ m|/$|? "dir" : "file";

		if(exists $parm->{type} && $type ne $parm->{type}) {
			print "\tX: $path --->type=$parm->{type}\n" if -t STDOUT;
		} elsif(exists $parm->{regexp} && $path !~ /$parm->{regexp}/i) {
			print "\tX: $path --->regexp=$parm->{regexp}\n" if -t STDOUT;
		} elsif(exists $parm->{regexpnot} && $path =~ /$parm->{regexpnot}/i) {
			print "\tX: $path --->regexpnot=$parm->{regexpnot}\n" if -t STDOUT;
		} elsif(exists $parm->{sizenot} && $size == $parm->{sizenot}) {
			print "\tX: $path --->sizenot=$parm->{sizenot}\n" if -t STDOUT;
		} else {
			next;
		}
		foreach my $f (split /\+/, $res->{$_}->{se}) { $found->{$f}--; }
		delete $res->{$_};
	}
}

sub ping_search_results($$) {
	my ($res, $found) = @_;
	local *F;

	$conf{check_hosts} or return;

	foreach(keys %$res) {
		$res->{$_}->{path} =~ m~^([^/]*)~;
		my $ip = $ipcache{$1} or next;
		$dead{$ip} = $_;  # presume dead until proven otherwise
	}
	if(open(F, "-|") == 0) {
		open STDERR, ">/dev/null";
		if(open(F, "|-") == 0) {
			exec $conf{check_hosts};
			die "$conf{check_hosts}: $!\n";
		}
		foreach(keys %dead) {
			print F "$_\n";
		}
		close F;
		exit;
	}
	while(<F>) {
		chop;
		delete $dead{$_};
	}	
	close F;
}

sub search(;$)
{
	my ($scriptname) = @_;
	my %res;
	my %found;

	$parm->{minsize} =~ s/(\d+)k/$1 * 1024/ei;
	$parm->{minsize} =~ s/(\d+)m/$1 * 1024 * 1024/ei;
	if($parm->{minsize} =~ s/(\w*)-(\w+)/$1 + 0/e) {
		$parm->{maxsize} = $2;
	}

	swing_search($parm, \%res, \%found) unless $ENV{NOSWING};
	dcse_search($parm, \%res, \%found) unless $ENV{NODANCE};
	infofind_search($parm, \%res, \%found) unless $ENV{NOINFOFIND};

	remove_search_dups(\%res, \%found, $parm->{dups});
	filter_search_results(\%res, \%found);
	ping_search_results(\%res, \%found) if $scriptname;

	return print_search_results(\%res, \%found, $parm->{sort}, $scriptname);
}

sub smbwatch_search_one(@) {
	my (@lines) = @_;

	printf "%s\n", join(" / ", @lines) if -t STDOUT;
	$parm = undef;
	foreach(@lines) {
		s/(#.*)?\s*$//;
		/./ or next;
		/^\s*(type|minsize|maxsize|maxhits|terms|terms_not|paths|paths_not|regexp|regexpnot|sizenot)\s*=\s*(.*\S)/i
			or die "'$_': invalid format\n"; 
		$parm->{$1} = $2;
	}
	search() and print "\n";
}

sub smbwatch_search()
{
	getopts('c:dnhv');
	my $rcfile = $opt_c || "$ENV{HOME}/.smbwatchrc";

	if(@ARGV) {
		foreach(@ARGV) { print "$_\n"; }
		smbwatch_search_one(@ARGV);
	} else {
		local *F;
		open F, $rcfile or die "$rcfile: $!\n";
		$/ = "";
		my @s = <F>;
		close F;
		$/ = "\n";

		foreach(@s) {
			smbwatch_search_one(split /\n/, $_);
		}
		close F;
	}
}