#!/usr/bin/perl -w -T # smb_network.cgi - Web interface to your SMB network # Copyright (C) 2000 Gordon Messmer # # 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # An SMB resource can be thought of as an extended file path, in this form: # //SERVER/SHARE/CWD/FILE # This should be the easiest way to consider any SMB resource, and this # CGI will try to keep as much of this path filled in as possible. # Debugging will print the commands run before running them. $debug = 0; # Not using images will speed up the browser just ever so slightly # but maybe you don't like them. $use_icons = 1; # Don't use MIME if you just want files to download, never using # applications to handle the files. $use_mime = 1; # Allowing users to upload files is optional $allow_uploads = 1; # Some regex's that will be reused through this script $WORKGROUP_RE = '((?:[\w-]+(?: (?=[\w-]))?)+)'; $NODE_RE = '((?:[\w-]+(?: (?=[\w-]))?)+)'; $SHARE_RE = '((?:[\w-]+(?:[ \'](?=[\w-]))?)+)'; $USER_RE = '([\w\s@]*)'; $PASS_RE = '(.*)'; $FILE_RE = '([^/\\\\:*?"<>|]*)'; $CWD_RE = "(\\\\?(?:${FILE_RE}\\\\?)*)"; $DOSATTR_RE = '[DAHSR]+'; $DIRATTR_RE = 'D[AHSR]*'; $ARCATTR_RE = '[D]*A[HSR]*'; $HDNATTR_RE = '[DA]*H[SR]*'; $SYSATTR_RE = '[DAH]*S[R]*'; $ROATTR_RE = '[DAHS]*R'; # Use syncronous output so that we can safely print a header and then # make a system() call that will print to STDOUT (and, hence, the browser). $| = 1; # set up the PATH for taint mode $ENV{'PATH'} = "/bin:/usr/bin:/usr/local/samba/bin"; # Set up a new CGI object to communicate with the user use CGI; $query = new CGI; # Include the module for mktemp use File::Temp qw/ :mktemp /; # Give all variables a blank initial state $USER = $PASS = $WORKGROUP = $SERVER = $SHARE = $CWD = $FILE = ""; # Configure variables from input if( defined($query->cookie('USERNAME')) ) { $USER = $query->cookie('USERNAME'); } if( defined($query->cookie('PASSWORD')) ) { $PASS = $query->cookie('PASSWORD'); } if( defined($query->param('WORKGROUP')) ) { $WORKGROUP = $query->param('WORKGROUP'); } if( defined($query->param('SERVER')) ) { $SERVER = $query->param('SERVER'); } if( defined($query->param('SHARE')) ) { $SHARE = $query->param('SHARE'); } if( defined($query->param('CWD')) ) { $CWD = $query->param('CWD'); } if( defined($query->param('FILE')) ) { $FILE = $query->param('FILE'); } # Un-taint input so it can't interfere with commands run sub my_untaintMe { my( $var, $rex ) = @_; if( $var =~ /$rex/ ) { return $1; } else { return ""; } } $USER = &my_untaintMe( $USER, "^$USER_RE" ); $PASS = &my_untaintMe( $PASS, "^$PASS_RE" );; $WORKGROUP = &my_untaintMe( $WORKGROUP, "^$WORKGROUP_RE" ); $SERVER = &my_untaintMe( $SERVER, "^$NODE_RE" ); $SHARE = &my_untaintMe( $SHARE, "^$SHARE_RE" ); $CWD = &my_untaintMe( $CWD, "^$CWD_RE" ); $FILE = &my_untaintMe( $FILE, "$FILE_RE\$" ); # Create URL encoded copies of each field for use in links $WORKGROUPURL = &encode( $WORKGROUP ); $SERVERURL = &encode( $SERVER ); $SHAREURL = &encode( $SHARE ); $CWDURL = &encode( $CWD ); # Further clean up input which will be used on the command line $WORKGROUP =~ s/([\`\$])/\\$1/g; $SERVER =~ s/([\`\$])/\\$1/g; $SHARE =~ s/([\`\$])/\\$1/g; $CWD =~ s/([\`\$])/\\$1/g; $FILE =~ s/([\`\$])/\\$1/g; # Set up new cookies @cookies = (); if( defined($query->param('COOKIE')) ) { if( $query->param('COOKIE') eq 'Set Identity' ) { $name_cookie = $query->cookie(-name=>'USERNAME', -value=>$query->param('USERNAME')); $pass_cookie = $query->cookie(-name=>'PASSWORD', -value=>$query->param('PASSWORD')); splice(@cookies, $#cookies+1, 0, $name_cookie); splice(@cookies, $#cookies+1, 0, $pass_cookie); $USER = $query->param('USERNAME'); $PASS = $query->param('PASSWORD'); } } sub debug_print { my $msg = $_[0]; if( $debug == 1 ) { print STDERR "$msg\n"; } } sub encode { my $orig = $_[0]; $orig =~ s/ /+/g; $orig =~ s/([^+\w])/sprintf("%%%x", ord($1))/eg; return $orig; } sub get_network_layout { $master_browser = ""; # Prepare a nmblookup command that will get the master browser's IP $mb_lookup_command = "nmblookup -M -"; if( $WORKGROUP ne "" ) { $mb_lookup_command .= " \"$WORKGROUP\""; } # Execute nmblookup and parse its output for the IP &debug_print( "$mb_lookup_command" ); @mb_out = `$mb_lookup_command`; $master_browser_ip = ""; foreach $line (@mb_out) { if( $line =~ /^([0-9.]+)\s*\001\002__MSBROWSE__\002/ && !$WORKGROUP ) { $master_browser_ip = $1; last; } if( $line =~ /^([0-9.]+)\s*$WORKGROUP\<1d\>/ ) { $master_browser_ip = $1; last; } } if( $master_browser_ip eq "" ) { print "Unable to find the master browser for this domain!"; print " This is a fatal error."; goto CGI_EXIT; } # Continue to resolve the master browser's name &debug_print( "nmblookup -A $master_browser_ip" ); @mb_name_out = `nmblookup -A $master_browser_ip`; foreach $line (@mb_name_out) { if( $line =~ /^\s*$NODE_RE\s*<00>\s*-\s*\w/ ) { $master_browser = $1; last; } } if( $master_browser eq "" ) { print "Unable to find the master browser for this domain!"; print " This is a fatal error."; goto CGI_EXIT; } # If no workgroup has been defined by the user, get the default from # the master browser if( $WORKGROUP eq "" ) { foreach $line (@mb_name_out) { if( $line =~ /^\s*$WORKGROUP_RE\s*<00>\s*-\s*\s*\w/ ) { $WORKGROUP = $1; $WORKGROUPURL = &encode($WORKGROUP); last; } } } if( $SERVER eq "" ) { $SERVER = $master_browser; $SERVERURL = &encode($SERVER); } } sub get_network_info { if( $WORKGROUP eq "" || $SERVER eq "" ) { &get_network_layout(); } # Global lists for efficiency's sake @workgroups = (); @servers = (); @shares = (); # Get a list of servers and workgroups available if( $USER ne "" ) { $ENV{'USER'} = "$USER%$PASS"; } $smbclient_command = "smbclient -N -L \"$SERVER\""; &debug_print( "$smbclient_command" ); @layout = `$smbclient_command`; $layout_section = ''; foreach $line (@layout) { if( $line =~ /ERRDOS/ ) { next; } if( $line =~ /Sharename.*Comment/ ) { $layout_section = "Shares"; next; } if( $line =~ /Server.*Comment/ ) { $layout_section = "Servers"; next; } if( $line =~ /Workgroup.*Master/ ) { $layout_section = "Workgroups"; next; } if( $line =~ /---------|^\s*$/ ) { next; } if( $layout_section eq "Shares" ) { splice(@shares, $#shares+1, 0, $line); next; } if( $layout_section eq "Servers" ) { splice(@servers, $#servers+1, 0, $line); next; } if( $layout_section eq "Workgroups" ) { splice(@workgroups, $#workgroups+1, 0, $line); next; } } chomp @workgroups; chomp @servers; chomp @shares; } sub print_network_layout { &print_workgroups(); &print_servers(); &print_shares(); } sub print_workgroups { if( ! defined(@workgroups) ) { &get_network_info(); } print < WGTABLE foreach $group (@workgroups) { if( $group =~ /^\s*$WORKGROUP_RE\s.*/ ) { print "\n"; } } print <

WGTABLE } sub print_servers() { if( ! defined(@servers) ) { &get_network_info(); } print <
WORKGROUPS
"; print "\"Workgroup" if( $use_icons == 1 ); print "$1"; print "
SVTABLE foreach $server (@servers) { if( $server =~ /^\s*$NODE_RE\s.*/ ) { print "\n"; } } print <

SVTABLE } sub print_shares() { if( ! defined(@shares) ) { &get_network_info(); } print <
SERVERS in $WORKGROUP
"; print "\"Server" if( $use_icons == 1 ); print "$1"; print "
SRTABLE foreach $share (@shares) { # Only print the disk shares that don't end with '$' if( $share =~ /^\s*$SHARE_RE\s*Disk/ ) { print "\n"; } } print <

SRTABLE } sub print_cwd_sort_routine() { $a_is_dir = $b_is_dir = 0; if( $a =~ / $DIRATTR_RE\s+(\d+)\s+(\w\w\w \w\w\w .. ..:..:.. \d+)$/ ){ $a_is_dir = 1; } if( $b =~ / $DIRATTR_RE\s+(\d+)\s+(\w\w\w \w\w\w .. ..:..:.. \d+)$/ ){ $b_is_dir = 1; } if( $a_is_dir and not $b_is_dir ){ return -1; } if( $b_is_dir and not $a_is_dir ){ return 1; } return $a cmp $b; } sub print_cwd () { # Set up the username and password in an environment variable, so we don't # have to pass it to smbclient on the command line. if( $USER ne "" ) { $ENV{'USER'} = "$USER%$PASS"; } $smbclient_command = "smbclient \"//$SERVER/$SHARE\" -N -c \"ls \\\"$CWD\\\\*\\\"\""; &debug_print( "$smbclient_command" ); @files = `$smbclient_command`; chomp( @files ); @files = sort print_cwd_sort_routine @files; print <
SHARES on $SERVER
"; print "\"Share" if( $use_icons == 1 ); print "$1"; print "
FLTABLE if( $CWDURL =~ /(.*)%5c.+/ ) { $PARENTURL = $1; print "\n"; } foreach $file (@files) { if( $file =~ /ERRDOS|ERRbadpw|ERRSRV/ or ($file =~ /NT_STATUS/ and not $line =~ /NT_STATUS_OK/ ) ) { print "\n"; last; } if( $file =~ /^ \. |^ \.\. / ) { next; } # Complex regex: # matching lines will start with two spaces (smbclient messages won't, # but the files listed will) continue through any number of characters, # terminating in a non-space character, followed by a decimal string # indicating the file size, followed by a standard date indicating # the file's last modification time. if( $file =~ /^ (.*?)($DOSATTR_RE)?\s+(\d+)\s+(\w\w\w \w\w\w .. ..:..:.. \d+)$/) { $file = $1; $attrs = $2; $fsize = $3; $fmod = $4; if( $attrs ) { $file =~ s/\s+$//; } else { $attrs = ""; } $fURL = &encode($file); print ""; print ""; print "\n"; } } print < EFLTABLE if( $allow_uploads == 1 ) { print < EUPLOADS } print <

FLTABLE } sub print_path_links () { print "
\n"; print " [Entire Network"; if( $SERVER ne "" and $SHARE ne "" ) { print " - \\\\$SERVER"; print "\\$SHARE"; $path = ""; # We use $query->param('CWD') here, because $CWD has been munged for # shell safety. This will only be used for display, so it's safe. foreach $dir (split /\\/, $query->param('CWD')) { next if ($dir eq ""); # Happens on the first, empty element of the path $path = "$path\\$dir"; $pathurl = &encode( $path ); print "\\$dir"; } # Finally, tarball link: print " (Download Directory)"; } print "]\n"; print "
\n"; } sub smb_mkdir () { # Set up the username and password in an environment variable, so we don't # have to pass it to smbclient on the command line. if( $USER ne "" ) { $ENV{'USER'} = "$USER%$PASS"; } my( $SMBERR, $err_file ) = mkstemp( '/tmp/smbnet.err.XXXXXX' ); $smbclient_command = "smbclient \"//$SERVER/$SHARE\" -N -E -c \"mkdir \\\"$CWD\\\\$FILE\\\"\" > /dev/null 2> $err_file"; &debug_print( "$smbclient_command" ); system( $smbclient_command ); while( $line = <$SMBERR> ) { if( $line =~ /ERRDOS|ERRbadpw|ERRSRV/ or ($line =~ /NT_STATUS/ and not $line =~ /NT_STATUS_OK/ ) ) { print "

Permission denied creating dir - Try setting a username and password and try again.

\n"; last; } } close $SMBERR; unlink $err_file; } sub smb_upload () { # Write the file contents to a temp file my( $TMPFILE, $tmp_file ) = mkstemp( '/tmp/smbnet.XXXXXX' ); my( $SMBERR, $err_file ) = mkstemp( '/tmp/smbnet.err.XXXXXX' ); $fh = $query->upload('FILE'); if( not defined( $fh ) ) { print "Error getting file handle from form.
"; } while( read($fh, $buffer, 1024) ) { print $TMPFILE $buffer; } close( $TMPFILE ); # Set up the username and password in an environment variable, so we don't # have to pass it to smbclient on the command line. if( defined($USER) ) { $ENV{'USER'} = "$USER%$PASS"; } $smbclient_command = "smbclient \"//$SERVER/$SHARE\" -N -E -c \"put $tmp_file \\\"$CWD\\\\$FILE\\\"\" > /dev/null 2> $err_file"; &debug_print( "Uploading file: \n" . `ls -l $tmp_file` . "$smbclient_command" ); system( $smbclient_command ); while( $line = <$SMBERR> ) { if( $line =~ /ERRDOS|Error|ERRSRV/ or ($line =~ /NT_STATUS/ and not $line =~ /NT_STATUS_OK/ ) ) { print "

Error uploading file to server

\n"; last; } } close $SMBERR; unlink $tmp_file; unlink $err_file; } sub smb_download () { # Set up the username and password in an environment variable, so we don't # have to pass it to smbclient on the command line. if( $USER ne "" ) { $ENV{'USER'} = "$USER%$PASS"; } my( $tmp_file ) = mktemp( '/tmp/smbnet.XXXXXX' ); my( $SMBERR, $err_file ) = mkstemp( '/tmp/smbnet.err.XXXXXX' ); $smbclient_command = "smbclient \"//$SERVER/$SHARE\" -N -E -c \"get \\\"$CWD\\\\$FILE\\\" $tmp_file\" > /dev/null 2> $err_file"; &debug_print( "$smbclient_command" ); system( $smbclient_command ); while( $line = <$SMBERR> ) { if( $line =~ /ERRDOS|Error|ERRSRV/ or ($line =~ /NT_STATUS/ and not $line =~ /NT_STATUS_OK/ ) ) { print $query->header('-type' => 'text/plain'); print "Error downloading file from server"; goto DOWNLOAD_CLEANUP; } } if( ! -e $tmp_file ) { print $query->header('-type' => 'text/plain'); print "Error downloading file from server"; goto DOWNLOAD_CLEANUP; } if( $use_mime ) { # Find the MIME type using the 'file' command $fmimetype = `file -i '$tmp_file'`; chomp $fmimetype; $fmimetype =~ s/.*: (.*)/$1/; if( $fmimetype eq "data" || $fmimetype eq "" ) { $fmimetype = 'application/octet-stream'; } } else { $fmimetype = 'application/octet-stream'; } # Get the file size so the browser can have a progress indicator. $fsize = (stat( $tmp_file ))[7]; print $query->header('-type' => $fmimetype, '-Content-Disposition' => "filename=\"$FILE\"", '-Content-Length' => $fsize); system( "cat $tmp_file" ); DOWNLOAD_CLEANUP: close $SMBERR; unlink $tmp_file; unlink $err_file; } sub smb_download_tar () { # Set up the username and password in an environment variable, so we don't # have to pass it to smbclient on the command line. if( $USER ne "" ) { $ENV{'USER'} = "$USER%$PASS"; } my( $SMBERR, $err_file ) = mkstemp( '/tmp/smbnet.err.XXXXXX' ); $smbclient_command = "smbclient \"//$SERVER/$SHARE\" -N -E -D \"$CWD\" -c \"tarmode full\" -Tc - 2> $err_file"; &debug_print( "$smbclient_command" ); while( $line = <$SMBERR> ) { if( $line =~ /ERRDOS|Error|ERRSRV/ or ($line =~ /NT_STATUS/ and not $line =~ /NT_STATUS_OK/ ) ) { print $query->header('-type' => 'text/plain'); print "Error downloading file from server"; goto DOWNLOAD_CLEANUP; } } # We use query->param('CWD') here, because $CWD has been munged for # shell safety. This will only be used for display, so it's safe. $TARFILE = $query->param('CWD'); $TARFILE =~ s/.*\\//; print $query->header('-type' => 'application/x-tar', '-Content-Disposition' => "filename=\"$TARFILE.tar\""); system( $smbclient_command ); DOWNLOAD_TAR_CLEANUP: close $SMBERR; unlink $err_file; } ################################################################################ # Print out cookies that need to be set, and the HTML header # When downloading files, we don't send back any HTML, so this has to be # a function. HTMLEND is always printed if we get that far. sub html_head () { my $title = ""; if( defined($_[0]) ) { $title = ": $_[0]"; } print $query->header('-cookie' => [@cookies]); print < SMB Network ${title} HTMLHEAD &print_path_links(); } ################################################################################ if( ! defined($query->param('ACTION')) ) { &html_head(); &print_network_layout(); } elsif( $query->param('ACTION') eq "BROWSE_SERVER" ) { &html_head( "\\\\${SERVER}\\" ); &print_shares(); } elsif( $query->param('ACTION') eq 'BROWSE_SHARE' ) { &html_head( "\\\\${SERVER}\\${SHARE}${CWD}" ); &print_cwd(); } elsif( $query->param('ACTION') eq 'MKDIR' ) { &html_head( "\\\\${SERVER}\\${SHARE}${CWD}" ); &smb_mkdir() if( $allow_uploads ); &print_cwd(); } elsif( $query->param('ACTION') eq 'UPLOAD' ) { &html_head( "\\\\${SERVER}\\${SHARE}${CWD}" ); &smb_upload() if( $allow_uploads ); &print_cwd(); } elsif( $query->param('ACTION') eq 'DOWNLOAD' ) { &smb_download(); exit; } elsif( $query->param('ACTION') eq 'DOWNLOAD_TAR' ) { &smb_download_tar(); exit; } else { &html_head(); &print_network_layout(); } ################################################################################ # Print out the HTML tail and exit CGI_EXIT: print <
Username: Password:
smb-network.cgi copyright Gordon Messmer, <gordon\@dragonsdawn.net>
Distributed under the GPL.
HTMLTAIL
FILES
Name Size Last Modified
"; print "\"Parent" if( $use_icons == 1 ); print "Parent Directory"; print "
"; print "Permission denied - Try setting a username and password and try again."; print "
"; if( $attrs =~ /D/ ) { print "\"Folder" if( $use_icons == 1 ); print "$file"; } else { # Normal files will have the same A tag, but different images # FIXME: We need icons for the other flags: AHSR if( $use_icons == 1 ) { if( $attrs =~ /A/ ) { print "\"File"; } elsif( $attrs =~ /H/ ) { print "\"Hidden"; } elsif( $attrs =~ /S/ ) { print "\"File"; } elsif( $attrs =~ /R/ ) { print "\"File"; } else { print "\"File"; } } print "$file"; } print "$fsize$fmod