# Copyright 2002-2017 Interchange Development Group and others

#

# 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. See the LICENSE file for details.

UserTag file-navigator Order mask

UserTag file-navigator addAttr

UserTag file-navigator Version 1.18

UserTag file-navigator Routine <<EOR

use vars qw/$CGI $Session $Tag $Scratch/;

eval {

require Fcntl;

local($^W) = 0;

import Fcntl qw/:mode/;

};

if ($@) {

*S_ISUID = sub {return 2048};

*S_ISGID = sub {return 1024};

*S_ISVTX = sub {return 512};

}

sub {

my ($dir_mask, $opt) = @_;

#::logDebug("file-nav dir_mask: $dir_mask opt: " . ::uneval($opt));

$dir_mask = '*';

my $base_admin = ( $::Variable->{UI_BASE} || 'admin');

my $base_url = $Vend::Cfg->{VendURL}

. '/'

. ($opt->{base_url} || $base_admin);

my $view_href = $opt->{view_href} || "$base_admin/do_view";

my $view_form = $opt->{view_form} || 'mv_arg=~FN~';

my $full_path;

my $action = $CGI::values{action} || '';

my $already_found;

my $edit_page = $opt->{edit_page} || "content_editor";

my $edit_form = $opt->{edit_form} || "ui_name=~FN~&ui_type=page";

my @errors;

my @messages;

my $idir_re;

if ($opt->{initial_dir}) {

$Vend::Session->{ui_cwd} = $opt->{initial_dir};

$idir_re = qr{^$opt->{initial_dir}/};

}

if($action eq 'chdir') {

my $newdir = $CGI::values{dir} || '.';

unless( Vend::File::allowed_file($newdir) ) {

$Scratch->{ui_error} = ::errmsg('Security violation');

return interpolate_html("[bounce page='$base_admin/error']");

}

if(! -d $newdir) {

$Scratch->{ui_error} = ::errmsg("%s not a directory", $newdir);

return interpolate_html("[bounce page='$base_admin/error']");

}

$Vend::Session->{ui_cwd} = $newdir || '.';

}

my $curdir = $Vend::Session->{ui_cwd} || '.';

$curdir =~ s:/+$::;

my @files;

FINDNAV: {

if($action eq 'find') {

my $regex;

my $string = $CGI::values{find};

if($string !~ /\S/) {

push @errors, ::errmsg("Refuse to find a blank or whitespace.");

last FINDNAV;

}

elsif( $string =~ /\(\s*\?\s*\{/) {

$Scratch->{ui_error} = ::errmsg('Security violation');

return interpolate_html("[bounce page='$base_admin/error']");

}

else {

eval {

if($string =~ /\*/ and $string !~ /\.\*/) {

$regex =~ s/\*/.*/g;

}

$regex = qr{$string};

};

if ($@ or ! $regex) {

push @errors, ::errmsg("%s is not a good search.", $regex);

last FINDNAV;

}

}

$full_path = 1;

require File::Find;

my $wanted;

local($SIG{__WARN__}) = sub { push @errors, $_ };

my %exclude;

if($CGI::values{find_action} =~ /\bfilename\b/) {

$wanted = sub {

push @files, $File::Find::name

if $_ =~ $regex;

};

}

else {

if($curdir eq '.' and ! $CGI::values{find_session}) {

%exclude = (qw! ./session 1 session 1 tmp 1 ./tmp 1!);

}

$wanted = sub {

local ($/) = undef;

if( -d $_ and $exclude{$File::Find::dir}) {

$File::Find::prune = 1;

return;

}

return unless -f _;

-s _ > 1_000_000

and do {

push(@errors,

errmsg("%s: refuse to find in megabyte-sized files",

$File::Find::name)

);

return;

};

open(TMPFINDNAV, "< $_")

or do {

push(@errors,

errmsg("%s: permission denied", $File::Find::name)

);

return;

};

my $str = <TMPFINDNAV>;

$str =~ $regex

and push (@files, $File::Find::name);

return;

};

}

File::Find::find($wanted, $curdir);

s:^./:: for @files;

if(@files) {

push @messages, errmsg("Found %s files.", scalar @files);

$already_found = 1;

}

else {

undef $full_path;

push @errors, errmsg("No files found.");

}

}

}

if($already_found) {

# do nothing

}

elsif($curdir eq '.') {

if($dir_mask eq '*') {

@files = grep $_ ne 'CVS', glob('*');

}

else {

@files = split /\s+/, $dir_mask;

}

}

else {

@files = grep $_ !~ m{/CVS$}, glob("$curdir/*");

}

my $this_page = $Global::Variable->{MV_PAGE};

my $this = Vend::Interpolate::tag_area($this_page);

$this =~ s/\?(.*)//;

my $up_img = qq{<img src="up.gif" align=center border=0 height=22 width=20 title="upload ~FN~">};

my $dn_img = qq{<img src="down.gif" align=center border=0 height=22 width=20 title="download ~FN~">};

my $vw_img = qq{<img src="index.gif" align=center border=0 height=22 width=20 title="view ~FN~">};

my $ed_img = qq{<img src="layout.gif" align=center border=0 height=22 width=20 title="edit ~FN~">};

my $dir_img = qq{<img src="folder.gif" align=center border=0 height=22 width=20 title="change directory to ~FN~">};

my $del_img = qq{<img src="delete.gif" align=center border=0 height=20 width=20 title="DELETE ~FN~">};

my $sp_img = qq{<img src="bg.gif" align=center border=0 height=20 width=20>};

my $do_perms;

$opt->{details} = $CGI->{details} unless defined $opt->{details};

if(defined $opt->{details}) {

$do_perms = $opt->{details};

}

elsif (defined $CGI->{details}) {

$do_perms = $Session->{ui_file_details} = $CGI->{details};

}

else {

$do_perms = $Session->{ui_file_details};

}

my $del_string = '';

$Tag->if_mm('advanced', 'delete_files')

and do {

$del_string = qq{<A onClick="return confirm('Are you sure you want to delete the file ~FN~?')" HREF="$Vend::Cfg->{VendURL}/$this_page?~ID~&mv_click=file_maintenance&ui_delete_file=~FN~&mv_action=back">$del_img</A>};

};

my $ftmpl = <<EOF;

<A HREF="$Vend::Cfg->{VendURL}/ui_download/~FN~?~ID~">$dn_img</A>$del_string<A HREF="$base_url/upload_file?~ID~&mv_arg=~FN~&ui_return_to=$this_page">$up_img</A><A HREF="$base_url/do_view?~ID~&mv_arg=~FN~">$vw_img</A>&nbsp;%s&nbsp;<A HREF="$Vend::Cfg->{VendURL}/$view_href?~ID~&$view_form">%s</A><BR>

EOF

my $utmpl = <<EOF;

<A HREF="$base_url/upload_file?~ID~&mv_arg=~FN~&ui_return_to=$this_page">$up_img</A>&nbsp;%s&nbsp;<A HREF="$base_url/upload_file?~ID~&mv_arg=~FN~&ui_return_to=$this_page">%s</A><BR>

EOF

my $ftmpl_ed;

if(! $do_perms and $opt->{edit_only}) {

$ftmpl_ed = <<EOF;

<A HREF="$base_url/$edit_page?~ID~&$edit_form&ui_return_to=$this_page">$ed_img</A>&nbsp;%s&nbsp;<A HREF="$base_url/$edit_page?~ID~&$edit_form&ui_return_to=$this_page">%s</A><BR>

EOF

}

else {

$ftmpl_ed = <<EOF;

<A HREF="$Vend::Cfg->{VendURL}/ui_download/~FN~?~ID~">$dn_img</A>$del_string<A HREF="$base_url/upload_file?~ID~&mv_arg=~FN~&ui_return_to=$this_page">$up_img</A><A HREF="$base_url/$edit_page?~ID~&$edit_form&ui_return_to=$this_page">$ed_img</A>&nbsp;%s&nbsp;<A HREF="$base_url/$edit_page?~ID~&$edit_form&ui_return_to=$this_page">%s</A><BR>

EOF

}

my $dtmpl = <<EOF;

<A HREF="$Vend::Cfg->{VendURL}/$this_page?~ID~&action=chdir&dir=~FN~">$dir_img</A>&nbsp;%s&nbsp;<A HREF="$Vend::Cfg->{VendURL}/$this_page?~ID~&action=chdir&dir=~FN~">%s</A><BR>

EOF

$dtmpl = "$sp_img$sp_img$sp_img$dtmpl" if $do_perms;

my @out;

my $out;

my @dir;

my @plain;

sub perm_line {

my $fn = shift;

my @perm = qw/

---

--x

-w-

-wx

r--

r-x

rw-

rwx

/;

my @det;

if (-l $fn) {

@det = lstat($fn);

}

else {

@det = stat(_);

}

my $time = POSIX::strftime("%d-%b-%Y %H:%M:%S", localtime($det[9]));

my $permstring = sprintf('%04o', $det[2]);

#push @messages, "$_ perms=$permstring\n";

$permstring = substr($permstring, -3, 3);

my $top;

my (@ugo) = split //, $permstring;

@ugo = map { $_ = $perm[$_] } @ugo;

if (-l _) { $top = 'l' }

elsif (-d _) { $top = 'd' }

elsif (-f _) { $top = '-' }

else { $top = '?' }

$ugo[0] =~ s/.$/s/ if $det[2] & S_ISUID();

$ugo[1] =~ s/.$/s/ if $det[2] & S_ISGID();

$ugo[2] =~ s/.$/t/ if $det[2] & S_ISVTX();

my $user = getpwuid($det[4]);

my $grp = getgrgid($det[5]);

$grp = substr($grp, 0, 8) if length($grp) > 8;

$user = substr($grp, 0, 8) if length($user) > 8;

my $perm = join "", $top, @ugo;

my $ret = sprintf(" <TT><SMALL>%s %-8s %-8s %s</SMALL></TT>", $perm, $user, $grp, $time);

$ret =~ s/ /&nbsp;/g;

return $ret;

}

my $perms = '';

for(@files) {

my $fn = $_;

$fn =~ s:.*/::

unless $full_path;

my $fe = $_;

$fe =~ s!([^-\w./:,])!sprintf('%%%02x', ord($1) )!eg;

my $perms;

$perms = perm_line($_) if($do_perms);

if(-d $_) {

push @dir, [$fe, $fn, $dtmpl, $perms];

}

elsif ($opt->{edit_all} || ($opt->{edit_only} && /\.html?$/) ) {

my $rn = $curdir . "/$fn";

$rn =~ s{$idir_re}{} if $idir_re;

push @plain, [$fe, $fn, $ftmpl_ed, $perms, $rn];

}

else {

push @plain, [$fe, $fn, $ftmpl, $perms];

}

}

$opt->{top_of_tree} ||= '.';

my $nd = $curdir;

if($nd ne $opt->{top_of_tree} and ! $opt->{no_up}) {

$nd =~ s:/[^/]*$::

or $nd = $opt->{top_of_tree};

my $msg = '<large><b>..</b></large> &#91;'

. errmsg ($opt->{parent_directory_message} || 'parent directory')

. '&#93;';

unshift @dir, [ $nd, $msg, $dtmpl ];

}

my $pc = \$Vend::Session->{pageCount};

unshift @dir, [ "$curdir/", errmsg('(new file)'), $utmpl ]

unless $opt->{no_new_file};

@dir = () if $opt->{no_dirs};

for(@errors) {

$out .= "<span class=cerror>$_</span><br>";

}

for(@messages) {

$out .= "<span class=cmessage>$_</span><br>";

}

my $template = $opt->{template} || '';

for (@dir, @plain) {

$$pc++;

$_->[2] = sprintf($_->[2], $_->[3], $_->[1]);

$_->[2] =~ s/~FN~/$_->[0]/g;

$_->[2] =~ s/~RN~/$_->[4]/g;

$_->[2] =~ s/~ID~/mv_session_id=$Session->{id}&mv_pc=$$pc/g;

if($template) {

my $t = $template;

$t =~ s/%s/$_->[2]/;

$out .= $t;

}

else {

$out .= $_->[2];

}

}

return $out;

}

EOR