\n";
print image($cfg{icon_message},"$text{sendmsg}");
print "\n";
print href("$all{back}","$text{goback}")."\n";
trailer;
}
my $key = "";
my $back = "";
foreach $key (keys %all) {
$all{$key} = urlDecode $all{$key};
}
if ($all{'mesg'} eq '') {
header ("$text{sendmsg}");
print "
$text{sendmsg2} ";
if ( $all{'host'} eq '' ) {
print "$text{workgroup} $all{group}";
} else {
print "$all{host}";
}
print ":
\n";
if ($all{'back'} eq '') {
$back = "$ENV{'HTTP_REFERER'}";
} else {
$back = "$all{'back'}";
}
print << "EOF" ;
EOF
trailer;
} else {
if ( $all{host} eq '' ) {
my @smbout = GetSMBHosts ("$all{master}","$all{group}");
if ( $#smbout < 0 ) {
header ("$text{no_group}");
print "$text{no_group2}
\n";
table (
href (shref("all"),image ($cfg{icon_all},"$text{network}")),
"$text{ent_net}
",
""
);
trailer;
exit;
}
my $line = "";
foreach $line ( @smbout ) {
SendHostMessage ($line->{name},$all{'mesg'});
}
Message_OK;
} else {
SendHostMessage ($all{'host'},$all{'mesg'});
Message_OK;
}
}
smb2www-980804/cgi-bin/smb2www.pl 100775 1750 1750 3346 6542206404 15563 0 ustar csmall csmall #! /usr/bin/perl
# SMB2WWW - a smb to WWW gateway; access windows computers through a browser
# Copyright (C) 1997 Remco van Mook
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 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.
# The author can be contacted by e-mail: remco@samba.anu.edu.au
use strict;
use smb2www;
my @smbout = GetSMBGroups;
header ("$text{welcome}");
table (
href ($cfg{linkto_other}, image ($cfg{icon_other},"$text{othernet}")),
"",
href ($cfg{linkto_other}, "$text{othernet}
")
);
table (
"\n"
);
my $line = "";
foreach $line ( @smbout ) {
my $url = shref ("group","$line->{name}","$line->{master}");
table (
"",
href ($url,image ($cfg{icon_group},"$text{workgroup}")),
"".href($url,"$line->{name}")."
"
);
}
trailer;
smb2www-980804/cgi-bin/smb2www.pm 100664 1750 1750 31601 6561650721 15602 0 ustar csmall csmall ### Copyright notice
# SMB2WWW - a smb to WWW gateway; access windows computers through a browser
# Copyright (C) 1997,1998 Remco van Mook
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 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.
# The author can be contacted by e-mail: remco@samba.anu.edu.au
### Configuration and common procedures for smb2www
## This is a perl module. Some headers
package smb2www;
use Exporter ();
use MIME::Base64;
use Time::Local; # for lmtime
use strict;
use vars qw( %cfg %text @ISA @EXPORT );
@ISA = qw(Exporter);
@EXPORT = qw( %cfg $cfg %text $text urlDecode urlEncode image table href
shref header trailer decode_query mimetype lmtime
GetSMBTar GetSMBFile GetSMBDir GetSMBShr
GetSMBHosts GetSMBGroups
httptime MakeAuth GetAuth
SendHostMessage
);
## Configuration
%cfg = ();
open (CONFIG,"/usr/local/smb2www/etc/smb2www.conf") or die "SMB2WWW: No config file found.";
while () {
if ( $_ =~ /([\w\_]+)\s*=\s*(.+)/ ) {
$cfg{$1} = $2;
}
}
close CONFIG;
## Multi-language support
%text = ();
open (LANGUAGE,"$cfg{cfgdir}/$cfg{language}.lang") or die "SMB2WWW: No language support found for $cfg{language}.";
while () {
if ( $_ =~/([\w\_]+)\s*=\s*(.+)/ ) {
$text{$1} = $2;
}
}
close LANGUAGE;
## Common procedures
# Nasty URL encoding/decoding stuff
sub urlDecode{
my $value= $_[0];
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
return $value;
};
sub urlEncode {
my $value=$_[0];
$value =~ s/([^a-zA-Z0-9\.\_\'\-\$\~\\\/])/'%'.unpack("H*",$1)/eg;
$value =~ tr/ /+/;
return $value;
};
# Getting info from the webserver
# Some security might be nice.. let's kill it at the first ; for now
# Only brave souls hack smb2www without going insane at all the refs..
sub decode_query {
my %query = ();
my $input;
if ($ENV{'REQUEST_METHOD'} eq "POST") {
chomp ($input = urlDecode );
} else {
$input = $ENV{'QUERY_STRING'};
}
my @security = split ( ';',$input);
my @qs = split ( '&', $security[0]);
my $entry;
foreach $entry (@qs) {
if ($entry =~ /([\w]+)=([^\&\?]+)/) {
my $key = $1;
my $value = $2;
$query{$key}=$value;
}
}
return %query;
};
# Return a HTML href tag
sub href {
return "$_[1]";
};
# Return a HTML image tag
sub image {
return "![\"$_[1]\"](\"$cfg{imgroot}/$_[0]\")
";
};
# Return a HTML table entry
sub table {
my @table = @_;
print "\n";
foreach ( @table ) {
print "| $_ | \n";
}
print "
\n";
}
# Return a SMB2WWW url tag
sub shref {
my ($type, $group, $master, $host, $share, $dir,
$user, $pass, $size, $date, $auth) = @_;
my @urlencoded = ($group,$master, $host,$share,$dir,$user,$pass);
for (@urlencoded) { $_ = urlEncode $_ }
($group,$master, $host,$share,$dir,$user,$pass) = @urlencoded;
my $url;
my $pwa;
if ( $auth eq "" ) {
$pwa = "user=$user&pass=$pass"
} else {
$pwa = "auth=$auth";
}
if ( (lc $type) eq "file" ) {
$url = "$cfg{cgiroot}/smbfile.pl/$host/$share/$size/$dir?$pwa&lm=".lmtime($date);
} elsif ( (lc $type) eq "tar" ) {
$url = "$cfg{cgiroot}/smbtar.pl/$host/$share$dir?$pwa";
} elsif ( (lc $type) eq "dir" ) {
$url = "$cfg{cgiroot}/smbdir.pl?group=$group&master=$master&host=$host&share=$share&dir=$dir&$pwa";
} elsif ( (lc $type) eq "share" ) {
$url = "$cfg{cgiroot}/smbshr.pl?group=$group&master=$master&host=$host";
} elsif ( (lc $type) eq "group" ) {
$url = "$cfg{cgiroot}/smbgrp.pl?group=$group&master=$master";
} elsif ( (lc $type) eq "all" ) {
$url = "$cfg{cgiroot}/smb2www.pl";
} elsif ( (lc $type) eq "msg" ) {
$url = "$cfg{cgiroot}/smbmsg.pl?group=$group&master=$master&host=$host";
} else {
$url = $_[0]; # Act stupid when acted stupid upon
}
return $url;
}
# Determine mimetype, given a file extension
sub mimetype {
my $test = lc $_[0];
my $type;
open MIME, $cfg{mimetype};
RULE: while ( ) {
my $line = $_;
if ( not ($line =~ /^$/) and not ($line =~ /^#/) ) {
if ( $line =~ /^([^\s]+)\s+([\w\ ]+)/ ) {
$type = $1;
if ( $2 =~ /$test/ ) {
last RULE;
} else {
$type = "";
}
}
}
}
close MIME;
$type = "application/octet-stream" if ($type eq "");
return $type;
}
# Calculate expiretime for header()
sub expiretime {
return httptime(time+$cfg{refresh});
}
# Calculate Last-Modified: timestamp out of a SMB timestamp
sub lmtime {
my $timestring = $_[0];
my %month = (
Jan => 0, Feb => 1, Mar => 2,
Apr => 3, May => 4, Jun => 5,
Jul => 6, Aug => 7, Sep => 8,
Oct => 9, Nov =>10, Dec =>11
);
my $time;
if ( $timestring =~ /^\w+ (\w+)[ ]+(\w+) (\w+):(\w+):(\w+) (\w+)/ ){
$time = timelocal ($5,$4,$3,$2,$month{$1},$6);
}
return $time; # Now put this into httptime
}
# Make a HTTP/1.1 certified timestamp out of a UNIX timestamp.
sub httptime {
my $time = $_[0];
my @days = qw (Sun Mon Tue Wed Thu Fri Sat);
my @months = qw (Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$istdst) = gmtime($time);
my $realyear;
if ($year < 70) {
$realyear = "20$year";
} else {
$realyear = "19$year";
}
return sprintf ("%s, %02d %s %s %02d:%02d:%02d GMT",
$days[$wday],$mday,$months[$mon],$realyear,$hour,$min,$sec);
}
# Starting a page
sub header {
my $exp = expiretime;
print << "EOF";
Cache-Control: $cfg{cache}
Expires: $exp
Content-type: text/html
$_[0]
EOF
if (not $_[1] =~ /norefresh/ ) {
print "\n";
}
print << "EOF";
$_[0]
EOF
};
# Finishing the page
sub trailer {
my $help = href("$cfg{cgiroot}/smbhelp.pl", image ($cfg{icon_help},"Help")."HELP
");
print << "EOF";
$help
Comments/remarks/kudos to:remco\@samba.anu.edu.au
EOF
};
## Interfacing perl with smbclient
#sort an array of hashes by $_->{name} (for GetSMBDir et al)
sub byname {
(lc $a->{name}) cmp (lc $b->{name})
}
# Gets the file //$host/$share/$file, using $user and $pass, to $target.
# And return the error code. If $target is unspecified,
# STDOUT is used (-).
# Syntax: $error = GetSMBFile ($host,$share,$file,$user,$pass,$target)
sub GetSMBFile {
my ($host, $share, $file, $user, $pass, $target) = @_;
if ( $target eq "") { $target = "-" };
$file =~ s/^(.*)\/([^\/]*)$/$1$2/ ;
if ( $user ne "" ) { $user="-U$user"; }
if ( $pass ne "") {
if ( $user eq "" ) {
$user = "-Uguest";
}
} else {
$pass = "-N";
}
my @args = ("$cfg{bindir}/smbclient", "//$host/$share", "$pass", "$user", "-d
0", "-c", "get \"$file\" $target");
return system (@args);
}
# Makes a TAR of //$host/$share/$dir, using $user and $pass, to $target.
# And return the error code. If $target is unspecified,
# STDOUT is used (-).
# Syntax: $error = GetSMBTar ($host,$share,$dir,$user,$pass,$target)
sub GetSMBTar {
my ($host, $share, $dir, $user, $pass, $target) = @_;
if ( $target eq "") { $target = "-" };
if ( $user ne "" ) { $user="-U$user"; }
if ( $pass ne "") {
if ( $user eq "" ) {
$user = "-Uguest";
}
} else {
$pass = "-N";
}
my @args = ("$cfg{bindir}/smbclient", "//$host/$share", "$pass", "$user", "-d0 ", "-D", "$dir", "-Tc", "$target");
return system (@args);
}
# Return an array with sorted dir and filelisting
# Syntax: @output = GetSMBDir (host,share,dir,user,pass)
# array contains hashes; keys: name, attr, size, date
sub GetSMBDir {
my ($host, $share, $dir, $user, $pass ) = @_;
my @dir = (); my @files = ();
if (! $user eq "") { $user = "-U".$user }
if ( $pass eq "") { $pass = "-N" }
my $lookup = "$cfg{bindir}/smbclient \"//$_[0]/$_[1]\" \"$pass\" $user -d0 -c ls -D \"$_[2]\"";
my @out = `$lookup`;
my $line;
foreach $line ( @out ) {
if ($line =~ /^ ([\S ]*\S|[\.]+) {5,}([HDRSA]+) +([0-9]+) (\S[\S ]+\S)$/g) {
my $rec = {};
$rec->{name} = $1;
$rec->{attr} = $2;
$rec->{size} = $3;
$rec->{date} = $4;
if ($rec->{attr} =~ /D/) {
push @dir, $rec;
} else {
push @files, $rec;
}
} elsif ($line =~ /^ ([\S ]*\S|[\.]+) {6,}([0-9]+) (\S[\S ]+\S)$/) {
my $rec = {};
$rec->{name} = $1;
$rec->{attr} = "";
$rec->{size} = $2;
$rec->{date} = $3;
push @files, $rec; # No attributes at all, so it must be a file
}
}
my @ret = sort byname @dir;
@files = sort byname @files;
foreach $line ( @files ) {
push @ret, $line;
}
return @ret;
}
# Return an array with sorted share listing
# Syntax: @output = GetSMBShr (host)
# array contains hashes; keys: name, type, comment
sub GetSMBShr {
my $share = $_[0];
my @ret = ();
my $lookup = "$cfg{bindir}/smbclient -L \"$share\" -d0";
my @out = `$lookup`;
my $line = shift @out;
while ( (not $line =~ /^\s+Sharename/) and ($#out >= -1) ) {
$line = shift @out;
}
if ($#out >= 0) {
$line = shift @out;
$line = shift @out;
while ( (not $line =~ /^$/) and ($#out >= -1) ) {
if ( $line =~ /^\s+(\S[\S ]{0,14})\s+(Disk|Printer|IPC)\s+([\S ]*)/ ) {
my $rec = {};
my $nearname = $1;
$rec->{type} = $2;
$rec->{comment} = $3;
if ( $nearname =~ /^([\S ]*\S)\s*$/ ) {
$rec->{name} = $1;
} else {
$rec->{name} = $nearname;
}
push @ret, $rec;
}
$line = shift @out;
}
}
return sort byname @ret;
}
# Return an array with sorted host listing
# Syntax: @output = GetSMBHosts (host,group)
# array contains hashes; keys: name, comment
sub GetSMBHosts {
my ($workgroup,$host) = @_;
my @ret = ();
my $lookup = "$cfg{bindir}/smbclient -L \"$host\" -W \"$workgroup\" -d0";
my @out = `$lookup`;
my $line = shift @out;
while ((not $line =~ /^This machine has a browse list/) and ($#out >= -1) ) {
$line = shift @out;
}
if ($#out >= -1) {
$line = shift @out;
$line = shift @out;
$line = shift @out;
$line = shift @out;
while ((not $line =~ /^$/) and ($#out >= -1)) {
if ( $line =~ /^\t([\S ]*\S) {5,}(\S[\S ]*|\S|)$/ ) {
my $rec = {};
$rec->{name} = $1;
$rec->{comment} = $2;
push @ret, $rec;
}
$line = shift @out;
}
}
return sort byname @ret;
}
# Return an array with sorted groups listing
# Syntax: @output = GetSMBGroups ()
# array contains hashes; keys: name, master
sub GetSMBGroups {
my @ret = ();
my $lookup = "$cfg{bindir}/smbclient -L \"$cfg{masterbrowser}\" -d0";
my @out = `$lookup`;
my $line = shift @out;
while ((not $line =~ /^This machine has a workgroup list/) and ($#out >= 0) ) {
$line = shift @out;
}
if ($#out >= -1) {
$line = shift @out;
$line = shift @out;
$line = shift @out;
$line = shift @out;
while ((not $line =~ /^$/) and ($#out >= -1) ) {
if ( $line =~ /^\t([\S ]*\S) {2,}(\S[\S ]*)$/ ) {
my $rec = {};
$rec->{name} = $1;
$rec->{master} = $2;
push @ret, $rec;
}
$line = shift @out;
}
}
return sort byname @ret;
}
sub SendHostMessage {
my ($host,$msg) = @_;
open ( MSGOUT, "| $cfg{bindir}/smbclient -M \"$host\" -d0 -U \"smb2www\" > /dev/null" );
print MSGOUT $msg;
close MSGOUT;
return "OK";
}
## User/Pass encryption stuff
sub MakeAuth {
my $unenc = "$_[0]:$_[1]";
my $length = length $unenc;
my $key = $cfg{key} ;
while ( (length $key) < $length ) {
$key = $key . $cfg{key};
}
my $crypt = substr ($key,0,$length);
my $b64enc = encode_base64($unenc ^ $crypt);
$b64enc =~ tr#+#,#; $b64enc =~ tr#/#.#;
return $b64enc;
}
sub GetAuth {
my $auth = $_[0];
$auth =~ tr#,#+#; $auth =~ tr#.#/#;
my $uudec = decode_base64($auth);
my $length = length $uudec;
my $key = $cfg{key} ;
while ( (length $key) < $length ) {
$key = $key . $cfg{key};
}
my $crypt = substr ($key,0,$length);
return split (":",($uudec ^ $crypt))
}
smb2www-980804/cgi-bin/smbdir.pl 100775 1750 1750 12456 6532514377 15467 0 ustar csmall csmall #! /usr/bin/perl
# SMB2WWW - a smb to WWW gateway; access windows computers through a browser
# Copyright (C) 1997 Remco van Mook
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 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.
# The author can be contacted by e-mail: remco@samba.anu.edu.au
use strict;
use smb2www;
select STDOUT; $| = 1;
$ENV{'USER'}=$cfg{username};
my %all=decode_query;
my $key = "";
foreach $key (keys %all) {
$all{$key} = urlDecode $all{$key};
}
if (($all{auth} eq "") and ($all{user}.$all{pass} ne "")) {
my $auth = MakeAuth ($all{user},$all{pass});
$all{auth} = $auth;
my $url = shref("dir","$all{group}","$all{master}","$all{host}","$all{share}",
"$all{dir}","","","","","$auth");
print << "EOF";
Content-type: text/html
Reloading for secure URL
EOF
exit;
} elsif ($all{auth} ne "") {
($all{user},$all{pass}) = GetAuth ("$all{auth}");
}
my @smbout = GetSMBDir ("$all{host}","$all{share}","$all{dir}","$all{user}","$all{pass}");
if ($smbout[0]->{name} eq "") {
header ("$text{req_pass} $all{share}$all{dir} $text{on_computer} $all{host} $text{or_acc_den}.");
my $group = urlEncode ($all{group});
my $master = urlEncode ($all{master});
my $host = urlEncode ($all{host});
my $share = urlEncode ($all{share});
my $dir = urlEncode ($all{dir});
print << "EOF";
$text{name_pass}