#!/usr/bin/perl -I.
# TODO: Cache domain/workgroup per-drive share
# TODO: Clickable box header
# TODO: Input validation of form inputs
# TODO: escape
# TODO: Permission controls
# TODO: Share-independent clipboard
# TODO: GUI changes (?)
# TODO: Set maximum file upload size via Apache::
# TODO: Display drive letter on browse page
# TODO: 'Select all' button
# TODO: Pull-down menu with bookmarks
# TODO: Bookmark sorting
# TODO: Display all file shares if there are no recently used ones
# TODO: Display cut items with faded icon and/or text color
# DONE: Rename (files and folders)
# DONE: Make rename js popup prompt compatible with older browsers
# DONE: Fix timestamps
# DONE: Display file sizes in pretty KB
# DONE: DNS resolution
# DONE: Supernat
# DONE: Set supernat addresses Pos::defaults
# DONE: Error pages
# DONE: WINS resolution
# DONE: Delete confirmation dialog
# DONE: Cut & paste
# DONE: Directory deletion
# DONE: 'Create directory' button
# DONE: Handle deep-linked file shares (in preview pane, as well)
# DONE: Preview pane with most commonly used list
# DONE: Username & password prompt if auth credentials aren't cached
# DONE: Share auth credentials with vpn client
# DONE: Copy & paste
# DONE: New smbclient-compatible Smb.pm
use strict;
use Pos::Webtop::FileShare::Smb;
use Pos::Webtop::Web::ContentModule;
use Digest::MD5 ();
use Pos::Webtop::OcxLauncher ();
package Pos::Webtop::Web::ContentModule::FileShares;
our @ISA = qw(
Pos::Webtop::Web::ContentModule
);
sub getAclRules
{
my $self = shift;
my $tb = $self->getToolBox();
my $db = $tb->getWebtopDbReader();
my $client = $tb->getClient();
my $userId = $client->getUserId();
if ( not defined $self->{'aclRules'} )
{
my @aclRules = ();
my @rules = $db->query( sql=> "
select
upper(protocol_name),
location,
upper(target_name)
from
w_user_acls a,
w_acl_targets t,
w_acl_protocols p
where
a.protocol_id = p.protocol_id
and t.target_id = a.target_id
and user_id = $userId order by rule_number
");
foreach ( @rules )
{
my ($protocol,$location,$target) = @{ $_ };
push @aclRules, {
protocol=> $protocol,
location=> $location,
target=> $target
};
}
$self->{'aclRules'} = \@aclRules;
}
return $self->{'aclRules'};
}
sub aclCanAccess
{
my $self = shift;
my ($server,$servers,$path,$protocol) = @{{@_}}{qw/server servers path protocol/};
$path =~ s/\\/\//g; # convert to forward slashes
# path comes in with a leading slash on it.. remove it
$path =~ s/^\///g;
# remove dupe slashes
$path =~ s/[\/]+/\//g;
# protocol is FILE for 'file shares (smb or other shares)'
# protocol is FTP for ftp
# servers allows you to pass an array ref of servers (like ip vs hostname)
if ( not defined $servers )
{
$servers = [$server];
}
my @checkLocations;
foreach ( @{ $servers } )
{
my $checkLocation = $_ . "/" . $path;
$checkLocation =~ s/[\\\/]$//g;
$self->{'debug'} and warn "aclCanAccess: checkLocation: $checkLocation\n";
push @checkLocations, $checkLocation;
# now we also check with a / at end incase it's a dir match in the policy
$checkLocation .= "/";
$self->{'debug'} and warn "aclCanAccess: checkLocation: $checkLocation\n";
push @checkLocations, $checkLocation;
}
# now check locations is filled with 'all possible representations of where we are going'
$protocol = "FILE" unless defined $protocol;
my $tb = $self->getToolBox();
my $db = $tb->getWebtopDbReader();
my $aclRules = $self->getAclRules();
# we iterate the rules, considering all that are our protocol.
my $defaultGood = 1;
my $good = undef;
foreach my $ar ( @{ $aclRules } )
{
$ar->{'protocol'} eq $protocol or next;
if ( not length( $ar->{'location'} ) )
{
# this is a 'default' policy for this protocol...
$defaultGood = ( $ar->{'target'} eq 'ALLOW' ? 1 : 0 );
next;
}
# now we have to convert the 'location' with * wildcards into a safe match regex
# and compare it against. We have to keep track if the last char was the * char
# since split will not put an 'empty' at the end of @pieces if it was... we need
# that.
my @pieces = split(/\*/,$ar->{'location'});
my @pieces2;
if ( $ar->{'location'} =~ /\*$/ )
{
push @pieces, "";
}
foreach my $piece ( @pieces )
{
$piece =~ s/^\\\\//g;
# this will replace \ or / with [\/]... which matches any /\ in regex
# note that I have to close and reopen the \Q \E combos here
$piece =~ s/[\\\/]/\E\[\\\/\]\Q/g;
push @pieces2, $piece;
}
# now @pieces2 is filled with safe chunks of regex that are / independent for path matches...
@pieces = ();
foreach my $piece ( @pieces2 )
{
$piece = "" unless defined $piece;
push @pieces, "\Q" . $piece . "\E";
}
# now @pieces is filled with things that are safe to use in regex
# place them in one big regex separated by .*
my $regex = "^" . join(".*",@pieces) . "\$";
# now we compare the regex to all the @checkLocations entries...
foreach ( @checkLocations )
{
$self->{'debug'} and warn "aclCanAccess: regex: $regex\n";
if ( $_ =~ /$regex/i )
{
# we match...
$good = ( $ar->{'target'} eq 'ALLOW' ? 1 : 0 );
last;
}
}
if ( defined $good )
{
last;
}
}
if ( not defined $good )
{
$good = $defaultGood
}
return $good;
}
sub randomMd5
{
my $data = rand() . rand() . rand() . rand();
my $md5 = Digest::MD5->new();
$md5->add( $data );
return $md5->hexdigest();
}
# be sure to commit on the webtopDbWriter after calling to this
sub storeShareInfo
{
my $self = shift;
my ($server, $share, $user, $password) = @{{@_}}{qw/server share user password/};
$self->{'displayGroup'} = randomMd5() unless defined $self->{'displayGroup'};
$self->{'storedShareId'} = 0 unless defined $self->{'storedShareId'};
$self->{'storedShareId'}++;
my $tb = $self->getToolBox();
my $db = $tb->getWebtopDbWriter();
$server = "" unless defined $server;
$share = "" unless defined $share;
$user = "" unless defined $user;
$password = "" unless defined $password;
$db->do( sql=> "
insert into client_session_share_info (
client_session_id,
display_group,
share_id,
server,
sharename,
username,
password
) values (
" . $tb->getClient()->getSessionId() . ",
'" . $self->{'displayGroup'} . "',
" . $self->{'storedShareId'} . ",
'" . $db->escape( dirty=> $server ) . "',
'" . $db->escape( dirty=> $share ) . "',
'" . $db->escape( dirty=> $user ) . "',
'" . $db->escape( dirty=> $password ) . "'
)
");
}
sub getStoredShareInfo
{
my $self = shift;
my ($shareId,$displayGroup) = @{{@_}}{qw/shareId displayGroup/};
return {} unless defined $shareId;
return {} unless defined $displayGroup;
my $tb = $self->getToolBox();
# even though this is a reader, i need the writer to be sure that we get the data from our last write
my $db = $tb->getWebtopDbWriter();
my @info = $db->query( sql=> "
select server, sharename, username, password
from client_session_share_info
where client_session_id = " . $tb->getClient()->getSessionId() . "
and display_group = '" . $db->escape( dirty=> $displayGroup ) . "'
and share_id = '" . $db->escape( dirty=> $shareId ) . "'
");
return {} unless @info;
my ($server,$share,$user,$password) = @{ $info[0] };
return {
server=> $server,
share=> $share,
user=> $user,
password=> $password
};
}
# be sure to call commit on the webtopDbWriter after using this
# this isn't even used -- all items are just left in db until session expires
# this shouldn't be an issue.. items are only stored on the front page or a
# manual login.
sub cleanupDisplayGroup
{
my $self = shift;
my ($displayGroup) = @{{@_}}{qw/displayGroup/};
my $tb = $self->getToolBox();
my $db = $tb->getWebtopDbWriter();
$db->do( sql=> "
delete from client_session_share_info
where client_session_id = " . $tb->getClient()->getSessionId() . "
and display_group = '" . $db->escape( dirty=> $displayGroup ) . "'
");
}
sub new
{
my $this = shift;
my $class = ref($this) || $this;
my ($self) = @{{@_}}{qw/self/};
if ( not defined $self )
{
$self = {};
bless($self,$class);
}
# setup base class
my %args = @_;
$args{'self'} = $self;
Pos::Webtop::Web::ContentModule->new( %args );
$self->{'smbShare'} = undef;
$self->{'debug'} = 0;
return $self;
}
sub altLinkCheck
{
my $self = shift;
my $toolBox = $self->getToolBox();
my $client = $toolBox->getClient();
my $ret = "";
my $userId = $client->getUserId();
my $db = $toolBox->getWebtopDbReader();
my @altLink = $db->query( sql=> "select link_text, link_href from w_user_alt_fileshares where user_id = $userId" );
if ( @altLink )
{
my ($text,$href) = @{ $altLink[0] };
$ret .= "Access Your File Shares: " .
HTML::Entities::encode($text) . "
\n";
}
return $ret;
}
sub canConnectNewFileShare
{
my $self = shift;
my $tb = $self->getToolBox();
my $client = $tb->getClient();
if ( not defined( $self->{'canConnectNewFileShare'} ) )
{
my $moduleAccess = $client->getAllowedContentModules();
$self->{'canConnectNewFileShare'} = $moduleAccess->{'FileShares'}->{'sm_newFileshare'};
}
return $self->{'canConnectNewFileShare'};
}
# (pure virtual defined in Pos::Webtop::Web::ContentModule)
sub main
{
my $self = shift;
my $toolBox = $self->getToolBox();
my $client = $toolBox->getClient();
my $cgi = $toolBox->getCgi();
my $ret = "";
$client->checkSession();
$ret .= $self->altLinkCheck();
if ( length($ret) )
{
my $page = $toolBox->getPage();
print $page->getHeaderHtml( title=> "File Share Browser" );
#$ret .= Pos::Webtop::OcxLauncher::getLauncherHtml( tb=> $toolBox );
print $ret;
print $page->getFooterHtml();
return 1;
}
my $act = $cgi->param('act');
if ( defined $act )
{
if ( $act eq "browseShareDir" || $act eq "Refresh" )
{
$ret .= $self->getShareBrowseHtml();
}
elsif ( $act eq "downloadFile" )
{
my $temp = $self->downloadFile();
defined($temp) and $ret .= $self->downloadFile();
}
elsif ( $act eq "uploadFile" || $act eq "Upload File" )
{
$ret .= $self->uploadFile();
}
elsif ( $act eq "Delete" )
{
$ret .= $self->deleteItems();
}
elsif ( $act eq "Rename" )
{
$ret .= $self->renameItems();
}
elsif ( $act eq "Cut" )
{
$ret .= $self->addItemsToClipboard( cut => 1 );
}
elsif ( $act eq "Copy" )
{
$ret .= $self->addItemsToClipboard( cut => 0 );
}
elsif ( $act eq "Paste" )
{
$ret .= $self->pasteClipboardItems();
}
elsif ( $act eq "Create Folder" )
{
$ret .= $self->createFolder();
}
elsif ( $act eq "RemoveDriveShare" )
{
$ret .= $self->removeDriveShare();
}
else
{
warn ref($self) . "->main(): user submitted an unknown act ('$act'); returning login page";
$ret .= $self->getShareLoginHtml();
}
}
else
{
$ret .= $self->getShareLoginHtml();
}
print $ret;
return 1;
}
# (pure virtual defined in Pos::Webtop::Web::ContentModule)
sub getPreviewHtml
{
my $self = shift;
my $ret = "";
my $toolBox = $self->getToolBox();
my $client = $toolBox->getClient();
my $cgi = $toolBox->getCgi();
$ret .= $self->altLinkCheck();
if ( length($ret) )
{
return $self->getPreviewHeader() . $ret . $self->getPreviewFooter();
}
eval { $toolBox->debugLog( msg => "######## ------------- blah") };
# OBSOLETE
#my $userId = $client->getUserId();
$ret = $self->getPreviewHeader();
$ret .= "
Recently used file shares:
";
# Get all of the users file shares out of the db
my (@appFileShares) = $self->getAppFileShares();
my (@webtopFileShares) = $self->getWebtopFileShares();
# TODO: combine these lists, then sort them based on last accessed date, then trim all but the top 5
my @unsortedFileShares = (@appFileShares,@webtopFileShares);
my @accessedFileShares;
if (@accessedFileShares) { $client->logger( severity=>'NORMAL', logMessage=>"WEBTOP Fileshares: ->getPreviewHtml() \@accessedFileShares has shit in it" ); }
my @unaccessedFileShares = ();
my %nodupes = ();
foreach my $fileShare (@unsortedFileShares)
{
if ( defined $fileShare->{'fshLastAccess'} && length($fileShare->{'fshLastAccess'}))
{
if ( not defined $nodupes{ $fileShare->{'fsvHostname'} . ":" . $fileShare->{'fshName'} } )
{
push(@accessedFileShares,$fileShare);
$nodupes{ $fileShare->{'fsvHostname'} . ":" . $fileShare->{'fshName'} } = 1;
}
}
else
{
push(@unaccessedFileShares,$fileShare);
}
}
# if now we add more to the end to make it at least 5 even if they weren't accessed ever
while ( scalar(@accessedFileShares) < 5 && scalar(@unaccessedFileShares) )
{
my $fileShare = shift @unaccessedFileShares;
if ( not defined $nodupes{ $fileShare->{'fsvHostname'} . ":" . $fileShare->{'fshName'} } )
{
$fileShare->{'fshLastAccess'} = 0;
push @accessedFileShares, $fileShare;
}
}
my @fileShares = sort { $b->{'fshLastAccess'} cmp $a->{'fshLastAccess'} } @accessedFileShares;
# Now that the sorting is done, just take the top 5
@fileShares = @fileShares[0..4];
my $tb = $self->getToolBox();
my $dbw = $tb->getWebtopDbWriter();
my $skinOemId = Pos::Webtop::Web::OEMLoader::getSkinOemId( oemId=> $tb->getOemId );
my $hadSomeDriveLetter = 0;
foreach ( @fileShares )
{
if ( $_->{'fshDriveLetter'} )
{
$hadSomeDriveLetter = 1;
last;
}
}
foreach my $fileShare (@fileShares)
{
#warn " Last access for ($fileShare->{'fshDriveLetter'}) $fileShare->{'fsvHostname'}: $fileShare->{'fshLastAccess'}";
if ( not ( defined $fileShare->{'fsvHostname'} && defined $fileShare->{'fshName'} ) ) { next; }
my $sharePath = "\\\\" . $fileShare->{'fsvHostname'} . "\\" . $fileShare->{'fshName'} . "\\";
$sharePath .= $fileShare->{'fshInitialFolder'} unless not defined $fileShare->{'fshInitialFolder'};
$self->storeShareInfo(
server=> $fileShare->{'fsvHostname'},
share=> $fileShare->{'fshName'},
user=> $fileShare->{'fsaUsername'},
password=> $fileShare->{'fsaPassword'}
);
if ( $hadSomeDriveLetter eq 1 )
{
$ret .= "
" .
( $client->getFormGetCode(
text => "$sharePath",
values => [
{ name => "act", value => "browseShareDir" },
{ name => ( $client->getPersistPrefix() . "module" ), value => "FileShares" },
{ name => "currentDir", value => HTML::Entities::encode(( "\\" . ( defined $fileShare->{'fshInitialFolder'} ? $fileShare->{'fshInitialFolder'} : "" ) )) },
{ name => "displayGroup", value=> $self->{'displayGroup'} },
{ name => "shareId", value=> $self->{'storedShareId'} },
{ name => "initialFolder", value => HTML::Entities::encode(( "" . ( defined $fileShare->{'fshInitialFolder'} ? $fileShare->{'fshInitialFolder'} : "" ) )) },
{ name => "isRecent", value=> 1 },
{ name => "admintool", vaue=> $fileShare->{'fshAdmintool'} }
])) . "
";
}
$dbw->commit();
$ret .= "
" . $client->getFormGetCode(
values => [ { name => 'module', value => 'FileShares' } ],
text => "More..."
) . "
";
# text => " File Share Browser"
$ret .= "
";
$ret .= $self->getPreviewFooter();
return $ret;
}
sub getPreviewTitle
{
return shift->{'previewTitle'};
}
sub getTitle
{
return shift->{'title'};
}
sub getPreviewWidth
{
return shift->{'previewWidth'};
}
# Returns Share Login Page HTML
sub getShareLoginHtml
{
my $self = shift;
my $toolBox = $self->getToolBox();
my $client = $toolBox->getClient();
my $cgi = $toolBox->getCgi();
my $isMobile = $client->isMobileWebtop();
my ($topText) = @{{@_}}{qw/topText/};
# Setup the form entry fields
my @loginFields =
(
{ name => "serverName",
desc => "Server Address",
size => ( $isMobile ? "10" : "25" )
},
{ name => "shareName",
desc => "Share Name",
size => ( $isMobile ? "10" : "15" )
},
{ name => "shareUserName",
desc => "Share Username",
size => ( $isMobile ? "10" : "15" )
}
);
# Page header
my $page = $toolBox->getPage();
# Currently, this is the default page for this content module so we won't add anything
#$page->addNavBarElement( description => "Login" );
my $ret = $page->getHeaderHtml( title => "File Shares: Login" );
#$ret .= Pos::Webtop::OcxLauncher::getLauncherHtml( tb=> $toolBox );
my $listBox = $toolBox->createBox( title => "File Shares", width => '500' );
my $customBox = $toolBox->createBox( title => "Connect to a New File Share" , width => '500');
# Form header
$ret .= "
\n";
}
$ret .= $page->getFooterHtml();
return $ret;
}
# Unable to get directory listing (unknown error) - asks users to re-enter server, share, username, password
sub getShareConnectErrorHtml
{
my $self = shift;
my $toolBox = $self->getToolBox();
my $cgi = $toolBox->getCgi();
my $dbr = $toolBox->getWebtopDbReader();
my $dbw = $toolBox->getWebtopDbWriter();
my $client = $toolBox->getClient();
my $userId = $client->getUserId();
my $isMobile = $client->isMobileWebtop();
my ($initialTry) = @{{@_}}{qw/initialTry/};
$initialTry = 0 unless defined $initialTry;
my ($admintool) = @{{@_}}{qw/admintool/};
$admintool = 1 unless defined $admintool;
# Format currentDir
my $currentDir = $cgi->param('currentDir');
$currentDir = '\\' unless $currentDir;
my $shareId = $client->getPersistedValue( name=> 'shareId' );
$shareId = $cgi->param('shareId') if defined $cgi->param('shareId');
my $displayGroup = $client->getPersistedValue( name=> 'displayGroup' );
$displayGroup = $cgi->param('displayGroup') if defined $cgi->param('displayGroup');
my $shareInfo = $self->getStoredShareInfo( shareId => $shareId, displayGroup=> $displayGroup );
my $shareUserName = $cgi->param('shareUserName');
!defined($shareUserName) || !length($shareUserName) and $shareUserName = $shareInfo->{'user'};
my $sharePassword = $shareInfo->{'password'};
#my $shareName = $shareInfo->{'share'};
my $shareName = $cgi->param('shareName');
#my $serverName = $shareInfo->{'server'};
my $serverName = $cgi->param('serverName');
defined($serverName) and $serverName =~ s/^\\\\//g;
$client->setPersistedValue( name=> "shareId", value=> $shareId );
$client->setPersistedValue( name=> "displayGroup", value=> $displayGroup );
my $initialFolder = $cgi->param('initialFolder');
my $errorMessageText = undef;
my $inputTextForServer = undef;
my $inputTextForShare = undef;
# Page header
my $page = $toolBox->getPage();
# Currently, this is the default page for this content module so we won't add anything
#$page->addNavBarElement( description => "Error: " );
my $ret = $page->getHeaderHtml( title => "File Shares: Login" );
#$ret .= Pos::Webtop::OcxLauncher::getLauncherHtml( tb=> $toolBox );
my $customBox = $toolBox->createBox( title => "File Share Login", width => '500' );
my $remoteAddress = $cgi->param('remoteAddress');
if($admintool eq '1')
{
!defined($remoteAddress) || !length($remoteAddress) and $remoteAddress = "\\\\" . $shareInfo->{'server'} . (defined($shareInfo->{'share'}) ? "\\" . $shareInfo->{'share'} . "" : "") . (defined($currentDir) ? "$currentDir" : "");
while ( $remoteAddress =~ /\\$/ ) { chop $remoteAddress }
$errorMessageText = "The drive share or username and password specified by your administrator are invalid. You may enter
your username and password to gain access to the file share. If this problem persists, contact your administrator.
(Note: Use your network username and password from work)";
$inputTextForServer = "" . HTML::Entities::encode($remoteAddress) . "";
}
else
{
!defined($remoteAddress) || !length($remoteAddress) and $remoteAddress = "\\\\" . $shareInfo->{'server'} . (defined($shareInfo->{'share'}) ? "\\" . $shareInfo->{'share'} . "" : "") . (defined($currentDir) ? "$currentDir" : "");
while ( $remoteAddress =~ /\\$/ ) { chop $remoteAddress }
#!defined($remoteAddress) and $remoteAddress = $serverName . (defined($shareName) && length($shareName)? "\\$serverName" : "") . (defined($currentDir) && length($currentDir) ? "\\$currentDir" : "");
$errorMessageText = "Invalid drive share, username, or password. Please verify information and reenter your password.
(Note: Use your network username and password from work)";
$inputTextForServer = "";
}
# Form header
$ret .= "
\n";
$ret .= $page->getFooterHtml();
return $ret;
}
# Normal browsing page - displays the contents of a folder in a file share
sub getShareBrowseHtml
{
my $self = shift;
my $toolBox = $self->getToolBox();
my $cgi = $toolBox->getCgi();
my $dbr = $toolBox->getWebtopDbReader();
my $dbw = $toolBox->getWebtopDbWriter();
my $client = $toolBox->getClient();
my $userId = $client->getUserId();
my $isMobile = $client->isMobileWebtop();
# So far, I am unable to detect the file share block size with stat(), so it's static
my $shareBlockSize = 512;
# TODO: Persist the username and password in the database
# TODO: Detect the share type (NetWare, DFS, etc.)
my $shareId = $client->getPersistedValue( name=> 'shareId' );
$shareId = $cgi->param('shareId') if defined $cgi->param('shareId');
my $displayGroup = $client->getPersistedValue( name=> 'displayGroup' );
$displayGroup = $cgi->param('displayGroup') if defined $cgi->param('displayGroup');
my $shareInfo = $self->getStoredShareInfo( shareId => $shareId, displayGroup=> $displayGroup );
my $shareUserName = $shareInfo->{'user'};
my $sharePassword = $shareInfo->{'password'};
my $shareName = $shareInfo->{'share'};
my $serverName = $shareInfo->{'server'};
$serverName =~ s/^\\\\//g;
$client->setPersistedValue( name=> "shareId", value=> $shareId );
$client->setPersistedValue( name=> "displayGroup", value=> $displayGroup );
my $admintool = $cgi->param('admintool');
my $manualFileShare = $cgi->param('manualFileShare');
my $manualFileShareAddress = $cgi->param('remoteAddress');
my $fromCache = 0;
my $currentDir = $cgi->param('currentDir');
my $initialFolder = $cgi->param('initialFolder');
my $usedUserValues = 0; # if this is set, we will NOT look for cached goodness later
if ( (defined $cgi->param('shareUserName') and length $cgi->param('shareUserName')) || $manualFileShare )
{
(undef,$serverName,$shareName,$currentDir) = split(/\\{1,2}/,$manualFileShareAddress,4);
$initialFolder = $currentDir;
$currentDir = "\\" . $currentDir;
$usedUserValues = 1;
$shareUserName = $cgi->param('shareUserName');
$sharePassword = $cgi->param('sharePassword');
$serverName =~ s/^\\\\//g;
$self->storeShareInfo( user=> $shareUserName, password=> $sharePassword, server=> $serverName, share=> $shareName );
$dbw->commit();
$client->setPersistedValue( name=> 'displayGroup', value=> $self->{'displayGroup'} );
$client->setPersistedValue( name=> 'shareId', value=> $self->{'storedShareId'} );
$self->{'initShareId'} = $self->{'storedShareId'};
$self->{'initDisplayGroup'} = $self->{'displayGroup'};
}
my ($canCacheCredentials) = $dbr->query( sql=> " select can_Cache_credentials from user_share_credential_caching where user_id = $userId " );
$canCacheCredentials = 1 unless defined $canCacheCredentials;
# here's a special hack that raz put in... the idea is this: with the new policy to allow or disallow
# credential caching, people without caching turned on can click on recently used links and they will not
# have usernames or passwords assigned to those shares. This means that if they previously used a share
# with login creds and then go back via the recent list, they are trying to auth without any creds initially...
# this is normally fine but if the remote server allows anonymous logins they are going to get in without the right
# permissions. To work around this, I have made the system return the connection error / login page screen before trying
# anything if the user has no password and username.... and only if it doesn't see the submit from the password prompt.
# This allows the user to enter an initial credential set for this use case.
# Format currentDir
$currentDir = '\\' unless $currentDir;
# Remove duplicate backslashes
while ( $currentDir =~ s/\\\\/\\/g ) { }
# OBSOLETE
#my $currentDirEsc = $currentDir;
#$currentDirEsc =~ s/\\/\\\\/g;
#cut off trailing slashes
chop($currentDir) if ($currentDir =~ /^(.+)\\$/);
chop($initialFolder) if ($initialFolder =~ /^(.+)\\$/);
# Set the upDir and upDirEsc strings
my $upDir = undef;
if ($currentDir eq "\\" . $initialFolder)
{
$upDir = undef;
}
elsif ( $currentDir =~ /^(.*)\\[^\\].*$/ )
{
$upDir = $1;
}
elsif ( $currentDir ne "\\" && $currentDir ne "" )
{
$upDir = "\\";
}
my $upDirEsc = $upDir;
if ( defined $upDir ) { $upDirEsc =~ s/\\/\\\\/g; }
# Page header
my $page = $toolBox->getPage();
$page->addNavBarElement(
description => "\\\\$serverName\\$shareName",
values => [
{ name => "act", value => "browseShareDir" },
{ name => "currentDir", value => ($upDir) }
]
);
my $path = $dbr->escapeLike(dirty => "\\\\$serverName\\$shareName");
# this block now runs to 'try auth cache for share' no matter what (this MUST happen before the page header so the
# block of code can replace a persisted value and have it correctly in the page header
if ( ! $usedUserValues )
{
$client->logger( severity=>'NORMAL', logMessage=>"WEBTOP Fileshares: ->getShareBrowserHtml() Looking for auth credentials in netresource auth cache" );
my (@authCacheRows) = $dbr->query( sql => "
SELECT
net_user, net_pass
FROM
netresource_auth_cache
WHERE
network_path like '$path%'
AND user_id = '$userId'
" . $dbr->getLimitOneRowString(prefix => 'AND' ) . "
");
foreach my $authCacheRow (@authCacheRows)
{
my $username = $authCacheRow->[0];
my $password = $authCacheRow->[1];
if ( ( defined $username && length $username ) || ( defined $password && length $password ) )
{
$password = "" unless defined $password;
$username = "" unless defined $username;
$client->logger( severity=>'NORMAL', logMessage=>"WEBTOP Fileshares: ->getShareBrowserHtml() Got cached username '$username' and password HIDDEN; resetting persisted values" );
#$client->setPersistedValue( name => 'shareUserName', value => $username );
#$client->setPersistedValue( name => 'sharePassword', value => $password );
$shareUserName = $username;
$sharePassword = $password;
# the init share function will use the new share number here to setup the share...
# they will be retrieved via the getPersistedValue function
$self->storeShareInfo( user=> $shareUserName, password=> $sharePassword, share=> $shareName, server=> $serverName );
$client->setPersistedValue( name=> 'shareId', value=> $self->{'storedShareId'} );
$client->setPersistedValue( name=> 'displayGroup', value=> $self->{'displayGroup'} );
$dbw->commit(); # make sure stored share info is saved
# we have to override the stored share id and display group for the init function to work right
$self->{'initShareId'} = $self->{'storedShareId'};
$self->{'initDisplayGroup'} = $self->{'displayGroup'};
# Indicate that credentials were obtained through the cache.
$fromCache = 1;
}
}
}
# If the credentials weren't obtained through the cache and
# they have an empty password, prompt them to enter it.
if (!$fromCache and
not ( defined($shareUserName) and length($shareUserName) and defined($sharePassword) and length($sharePassword) )
and defined $cgi->param('isRecent')
)
{
$client->logger( severity=>'NORMAL', logMessage=>"WEBTOP Fileshares: ->getShareBrowserHtml() detected user with no password caching ability -- giving a chance to provide credentials." );
return $self->getShareConnectErrorHtml( initialTry=> 1, admintool=> $admintool );
}
my $ret .= $page->getHeaderHtml( title => "File Share Browser: Connected");
#$ret .= Pos::Webtop::OcxLauncher::getLauncherHtml( tb=> $toolBox );
# TODO: Clickable folders in link on
# my $titleHtml = "File Share Browser: \\" .
# ( $client->getFormGetCode(
# text => "$sharePath",
# values => [
# { name => "act", value => "browseShareDir" },
# { name => "currentDir", value => ($upDir) }
# ])
# ) . "";
# my $browseBox = $toolBox->createBox(
# title => "File Share Browser: \\\\$serverName\\$shareName$currentDir",
# width => "100%"
# );
my $currentDirCopy = $currentDir;
my $initialFolderCopy = $initialFolder;
$initialFolderCopy =~ s/\\/\\\\/g;
$currentDirCopy =~ s/^\\$initialFolderCopy//g;
$initialFolderCopy =~ s/\\\\/\\/g;
my @initialFolders = split /\\/,$initialFolderCopy;
my @currentDirs = split /\\/,$currentDirCopy;
my $cleanShareName = $shareName;
$cleanShareName =~ s/\\//g;
my $shareLink =
$client->getFormGetCode(
text => ("$cleanShareName",
tagAttributes => [
{ name => "class", value => "BOXLINK"},
],
values => [
{ name => "act", value => "browseShareDir" },
{ name => "initialFolder", value => $initialFolder },
{ name => "currentDir", value => "\\" }
]));
my $dow = "";
my $dizzle = "";
my $i = 1;
foreach my $initialFolders ( @initialFolders )
{
if (!length($initialFolders))
{
next;
}
$dizzle .= "\\$initialFolders";
$dizzle =~ s/\\\\/\\/g;
if ($i == scalar(@initialFolders))
{
$dow .= "\\";
$dow .=
$client->getFormGetCode(
text => ("$initialFolders",
tagAttributes => [
{ name => "class", value => "BOXLINK"},
],
values => [
{ name => "act", value => "browseShareDir" },
{ name => "initialFolder", value => $initialFolder },
{ name => "currentDir", value => "$dizzle" }
]));
}
else
{
$dow .= "\\$initialFolders";
}
$i++;
}
my $dow2 = "";
my $dizzle2 = "";
foreach my $currentDirs ( @currentDirs )
{
if (!length($currentDirs))
{
next;
}
$dizzle2 .= "\\$currentDirs";
$dizzle2 =~ s/\\\\/\\/g;
$dow2 .= "\\";
$dow2 .=
$client->getFormGetCode(
text => ("$currentDirs",
tagAttributes => [
{ name => "class", value => "BOXLINK"},
],
values => [
{ name => "act", value => "browseShareDir" },
{ name => "initialFolder", value => $initialFolder },
{ name => "currentDir", value => "\\$initialFolder$dizzle2" }
]));
}
my $browseBox = $toolBox->createBox(
title=>"File Share Browser: \\\\$serverName\\" . (length($dow) ? "$cleanShareName$dow" : "$shareLink" ) . "" . (length($dow2) ? "$dow2" : "" ) . "",
width => "100%"
);
# JS, Form and table header
$ret .= "
";
$ret .= "