#!/usr/bin/perl -w
#
# script smb2www-2.cgi : provide web interface to access smb filesystem
# with Filesys::SmbClient and libsmclient.so
# Copyright 2001 A.Barbet alian@alianwebserver.com. All rights reserved.
#
# $Revision: 1.5 $
# $Date: 2002/10/18 13:02:09 $
# $Author: alian $
#------------------------------------------------------------------------------
use CGI qw/:standard :html3 :netscape escape unescape/;
use CGI::Carp qw/fatalsToBrowser/;
use strict;
use Filesys::SmbClient;
# ------ Config --------------------------------------------------------------#
my $SN = $ENV{SCRIPT_NAME} || "smb2www-2.cgi";
my $mimetype = "/etc/mime.types";
my $user = "alian";
my $password = "password";
my $workgroup = "alian"; # optional
my $maskFile = 0666; # for upload file
my $maskDir = 0755; # for created dir
my $css = "http://saturne/smb2www.css"; # for fun
# ------ End config ----------------------------------------------------------#
my $smb = new Filesys::SmbClient(username => $user,
password => $password,
workgroup => $workgroup,
debug => 10)
|| die "Can't connect:$!\n";
&main();
sub main
{
my $buffer;
# browse a share or a dir
if (param('browse'))
{ print browse(param('browse')); }
# read a file
elsif (param('readfile'))
{ print read_file(param('readfile')); }
# put a file
elsif (param('filename'))
{ print upload_file(param('filename'), param('dir')); }
# create a dir
elsif (param('directory'))
{
my $dir = param('dir').'/'.param('directory');
$smb->mkdir($dir, $maskDir) ||
print header,"Can't create ", $dir, ":$!\n";
print browse(param('dir'));
}
# delete a file
elsif (param('delete') || param('deleteDir'))
{
print header;
my $dir;
foreach my $f (param('delete'))
{
if (unescape($f)=~/^(.*)\/[^\/]*$/) { $dir = $1; }
my $res = $smb->unlink(unescape($f));
if ($res) { print unescape($f)," deleted<br>\n"; }
else { print "Can't delete ",unescape($f),":$!<br>\n"; }
}
foreach my $f (param('deleteDir'))
{
if (unescape($f)=~/^(.*)\/[^\/]*$/) { $dir = $1; }
my $res = $smb->rmdir_recurse(unescape($f));
if ($res) { print unescape($f)," deleted<br>\n"; }
else { print "Can't delete ",unescape($f),":$!<br>\n"; }
}
print "<a href=\"$SN?browse=$dir\">Back to $dir</a>",
end_html;
}
# first form
else
{
if ($workgroup)
{ print browse("smb://".$workgroup); }
else
{
print header,
start_html
( -'title' => 'smb2www2',
-'author' => 'alian@alianwebserver.com',
-'meta' => {'keywords' => 'smb',
-'copyright'=>'Copyright 2001 AlianWebServer'},
-'style' => {'src' => $css},
-'dtd' => '-//W3C//DTD HTML 4.0 Transitional//EN"'.
' "http://www.w3.org/TR/REC-html40/loose.dtd')."\n";
}
print h1("smb2www - the come back"),
start_form.
textfield(-name=>'browse')."(ex: <i>smb://my_smb_server</i> or
<i>smb://my_workgroup</i>)<br>".
submit."\n".end_form;
}
print end_html,"\n";
}
#------------------------------------------------------------------------------
# Method that browse content of $rep
#------------------------------------------------------------------------------
sub browse
{
my ($rep) = @_;
my ($i,$j,$tf,@lf,@lr,@ls,@lm,$buffer, $style)=(0,0,0);
chop($rep) if ($rep=~/\/$/);
return undef if (!$rep);
# Read directory
my $D = $smb->opendir($rep) || die "Can't read $rep:$!\n";
my @f = $smb->readdir_struct($D);
$smb->close($D);
# Sort file by name
@f = sort { $a->[1] cmp $b->[1] } @f;
# For each item ...
foreach my $f (@f)
{
# Reformat url for dir . and ..
# and build new url in $ref
my $ref;
if ($f->[1] eq ".") { $ref = $rep; }
elsif ($f->[1] eq "..")
{ if ($rep=~/(.*)\/[^\/]*$/) { $ref = $1; } }
elsif ($f->[0] == SMBC_SERVER) { $ref = "smb://".$f->[1];}
else { $ref = $rep.'/'.$f->[1]; }
my $refe = escape($ref);
# A directory
if ($f->[0] == SMBC_DIR)
{
# modulo for css style
if (++$i % 2) { $style = "style1"; }
else { $style = "style2"; }
my $z="<input type=\"checkbox\" name=\"deleteDir\"
value=\"$refe\">";
# dont show delete for . and ..
if ($f->[1] eq '.' || $f->[1] eq '..') { $z=" "; }
my $item = "<tr class=\"$style\">
<td class=\"name\" colspan=\"3\">
[Dir] <a class=\"dir\" href=\"$SN?browse=$refe\">". $f->[1]."</a>
</td>
<td>$z</td>
</tr>\n";
push(@lr, $item);
}
# A file
elsif ($f->[0] == SMBC_FILE)
{
# modulo for css style
if (++$j % 2) { $style = "style1"; }
else { $style = "style2"; }
my @l = $smb->stat($ref);
my $item = "<tr class=\"$style\">
<td class=\"name\"><a class=\"file\" href=\"$SN?readfile=$refe\">".
$f->[1]."</a></td>
<td class=\"size\">".sizeOf($l[7])."</td>
<td class=\"time\">".localtime($l[11])."</td>
<td><input type=\"checkbox\" name=\"delete\" value=\"$refe\"></td>
</tr>\n";
push(@lf, $item); $tf+=$l[7];
}
# a share
elsif ($f->[0] == SMBC_FILE_SHARE)
{
# modulo for css style
if (++$i % 2) { $style = "style1"; }
else { $style = "style2"; }
my $item = "<tr class=\"$style\">
<td class=\"name\">[Share] <a class=\"name\" href=\"$SN?browse=$refe\">".
$f->[1]."</a></td>
<td class=\"comment\">".$f->[2]."</td>
</tr>";
push(@ls, $item);
}
# a server
elsif ($f->[0] == SMBC_SERVER)
{push(@lm, "[Server] <a class=\"server\" href=\"$SN?browse=$refe\">".
$f->[1]."</a>"); }
}
#
# Html format
#
$buffer .= join("<br>\n", @lm)."<br>\n" if ($#lm != -1);
if ($#ls != -1)
{ $buffer .= "<table class=\"share\">".join(" ", @ls)."</table><br>\n"; }
$buffer.="<form onsubmit=\"return confirm('Confirm ?')\">
<table border=\"1\">";
if ($#lr != -1)
{ $buffer .= join(" ", @lr); }
if ($#lf != -1)
{ $buffer.= join("\n", @lf); }
$buffer.="<td>".$#lf." file(s)</td>
<td>".sizeOf($tf)."</td><td></td>
<td><input type=\"submit\" value=\"delete\">"
if ($#lf != -1 or $#lr != -1);
$buffer.="</table></form>\n";
if ($#ls == -1 && $#lm == -1 && $#f != -1)
{
$buffer.= "<ul><li>".start_multipart_form().
"Put a file on $rep:<br>".
filefield(-name=>'filename',-size=>45).
hidden(-name=>'dir',-value=>$rep).
submit('download','Upload').
endform."</li>\n<li>".
start_multipart_form().
"Create a dir on $rep:<br>".
textfield(-name=>'directory',-size=>45).
hidden(-name=>'dir',-value=>$rep).
submit('download','Create').
endform."</li></ul>";
}
$buffer = header.
start_html
( -'title' => 'smb2www2',
-'author' => 'alian@alianwebserver.com',
-'meta' => {'keywords' => 'smb',
-'copyright'=>'Copyright 2001 AlianWebServer'},
-'style' => {'src' => $css},
-'dtd' => '-//W3C//DTD HTML 4.0 Transitional//EN"'.
' "http://www.w3.org/TR/REC-html40/loose.dtd')."\n".
h1("You are on: ".linksOf(unescape($rep))).$buffer;
return $buffer;
}
#------------------------------------------------------------------------------
# Method that display file $file
#------------------------------------------------------------------------------
sub read_file
{
my ($file)=@_;
my ($buffer, $ext);
my $FD = $smb->open($file, 0666) || die "Can't read $file:$!\n";
while (my $buf = $smb->read($FD, 1024)) { $buffer.=$buf; }
$smb->close($FD);
if (param('readfile')=~/\.(\w{0,5})$/) { $ext = $1; }
return "Content-type: ".mimetype($ext, $mimetype)."\n\n".$buffer;
}
#------------------------------------------------------------------------------
# Method that put a file push with http on directory $dir
#------------------------------------------------------------------------------
sub upload_file
{
my ($file, $dir)= @_;
my($nom);
if ($file=~/.*\\(.*)$/) {$nom=$1;}
else {$nom=$file;}
$nom = $dir."/".$file;
my $FD = $smb->open(">$nom", 0666) || die "Can't create $nom:$!\n";
while (<$file>) { $smb->write($FD, $_); }
$smb->close($FD);
return browse($dir);
}
#------------------------------------------------------------------------------
# Determine mimetype, given a file extension
#------------------------------------------------------------------------------
sub mimetype
{
my $test = lc $_[0];
my $file = $_[1];
my $type;
open (MIME, $file) || die "can't read $file:$!\n";
RULE: while ( <MIME> ) {
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;
}
#------------------------------------------------------------------------------
# For a given url, split for each / and create a links for each parts
#------------------------------------------------------------------------------
sub linksOf
{
my ($url)=@_;
my ($v,$u)=("smb://");
if ($url =~ /^smb:\/\/(.+)/)
{
my $l=$1;
if ($l=~/\//)
{
my @l = split(/\//,$l);
foreach my $part (@l)
{
$v.=$part."/";
$u.="<a href=\"$SN?browse=$v\">$part</a>/";
}
}
else { $u = "<a href=\"$SN?browse=smb://$l\">$l</a>/"; }
}
if ($workgroup)
{$u = "<a href=\"$SN?browse=smb://$workgroup\">smb://</a>".$u; }
else { $u = "smb://".$u; }
return $u;
}
#------------------------------------------------------------------------------
# For a size in octets, return a size in o. ko. mo. go
#------------------------------------------------------------------------------
sub sizeOf
{
my $size = shift;
if ($size < 2**10) { return $size." o."; }
elsif ($size < 2**20) { return sprintf("%.1f", $size/2**10)."Ko."; }
elsif ($size < 2**30) { return sprintf("%.1f",$size/2**20)."Mo."; }
elsif ($size < 2**40) { return sprintf("%.1f",$size/2**30)."Go."; }
}
syntax highlighted by Code2HTML, v. 0.9.1