code/UI_Tag/file_navigator.coretag

   1 # Copyright 2002-2007 Interchange Development Group and others
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.  See the LICENSE file for details.
   7 #
   8 # $Id: file_navigator.coretag,v 1.17 2007-12-21 03:32:43 mheins Exp $
   9
  10 UserTag file-navigator Order    mask
  11 UserTag file-navigator addAttr
  12 UserTag file-navigator Version  $Revision: 1.17 $
  13 UserTag file-navigator Routine  <<EOR
  14 use vars qw/$CGI $Session $Tag $Scratch/;
  15 eval {
  16         require Fcntl;
  17                 local($^W) = 0;
  18         import Fcntl qw/:mode/;
  19 };
  20 if ($@) {
  21         *S_ISUID = sub {return 2048};
  22         *S_ISGID = sub {return 1024};
  23         *S_ISVTX = sub {return 512};
  24 }
  25 sub {
  26         my ($dir_mask, $opt) = @_;
  27
  28
  29 #::logDebug("file-nav dir_mask: $dir_mask opt: " . ::uneval($opt));
  30     $dir_mask = '*';
  31
  32         my $base_admin = ( $::Variable->{UI_BASE} || 'admin');
  33         my $base_url = $Vend::Cfg->{VendURL}
  34                                 . '/'
  35                                 . ($opt->{base_url} || $base_admin);
  36         my $view_href = $opt->{view_href} || "$base_admin/do_view";
  37         my $view_form = $opt->{view_form} || 'mv_arg=~FN~';
  38         my $full_path;
  39         my $action = $CGI::values{action} || '';
  40         my $already_found;
  41
  42         my $edit_page = $opt->{edit_page} || "content_editor";
  43         my $edit_form = $opt->{edit_form} || "ui_name=~FN~&ui_type=page";
  44
  45         my @errors;
  46         my @messages;
  47
  48         my $idir_re;
  49         if ($opt->{initial_dir}) {
  50                 $Vend::Session->{ui_cwd} = $opt->{initial_dir};
  51                 $idir_re = qr{^$opt->{initial_dir}/};
  52         }
  53
  54         if($action eq 'chdir') {
  55                 my $newdir = $CGI::values{dir} || '.';
  56                 unless( Vend::File::allowed_file($newdir) ) {
  57                         $Scratch->{ui_error} = ::errmsg('Security violation');
  58                         return interpolate_html("[bounce page='$base_admin/error']");
  59                 }
  60                 if(! -d $newdir) {
  61                         $Scratch->{ui_error} = ::errmsg("%s not a directory", $newdir);
  62                         return interpolate_html("[bounce page='$base_admin/error']");
  63                 }
  64                 $Vend::Session->{ui_cwd} = $newdir || '.';
  65         }
  66
  67         my $curdir = $Vend::Session->{ui_cwd} || '.';
  68         $curdir =~ s:/+$::;
  69         my @files;
  70
  71         FINDNAV: {
  72                 if($action eq 'find') {
  73                         my $regex;
  74                         my $string = $CGI::values{find};
  75                         if($string !~ /\S/) {
  76                                 push @errors, ::errmsg("Refuse to find a blank or whitespace.");
  77                                 last FINDNAV;
  78                         }
  79                         elsif( $string =~ /\(\s*\?\s*\{/) {
  80                                 $Scratch->{ui_error} = ::errmsg('Security violation');
  81                                 return interpolate_html("[bounce page='$base_admin/error']");
  82                         }
  83                         else {
  84                                 eval {
  85                                         if($string =~ /\*/ and $string !~ /\.\*/) {
  86                                                 $regex =~ s/\*/.*/g;
  87                                         }
  88                                         $regex = qr{$string};
  89                                 };
  90                         }
  91
  92                         if($@ or ! $regex) {
  93                                 push @errors, ::errmsg("%s is not a good search.", $regex);
  94                                 last FINDNAV;
  95                         }
  96
  97                         $full_path = 1;
  98                         require File::Find;
  99                         my $wanted;
 100
 101                         local($SIG{__WARN__}) = sub { push @errors, $_ };
 102
 103                         my %exclude;
 104                         if($CGI::values{find_action} =~ /\bfilename\b/) {
 105                                 $wanted = sub {
 106                                         push @files, $File::Find::name
 107                                                 if $_ =~ $regex;
 108                                 };
 109                         }
 110                         else {
 111                                 if($curdir eq '.' and ! $CGI::values{find_session}) {
 112                                         %exclude = (qw! ./session 1 session 1 tmp 1 ./tmp 1!);
 113                                 }
 114                                 $wanted = sub {
 115                                         local ($/) = undef;
 116                                         if( -d $_ and $exclude{$File::Find::dir}) {
 117                                                 $File::Find::prune = 1;
 118                                                 return;
 119                                         }
 120                                         return unless -f _;
 121                                         -s _ > 1_000_000
 122                                                 and do {
 123                                                         push(@errors,
 124                                                                 errmsg("%s: refuse to find in megabyte-sized files",
 125                                                                                 $File::Find::name)
 126                                                                 );
 127                                                         return;
 128                                                 };
 129                                         open(TMPFINDNAV, "< $_")
 130                                                 or do {
 131                                                         push(@errors,
 132                                                                 errmsg("%s: permission denied", $File::Find::name)
 133                                                                 );
 134                                                         return;
 135                                                 };
 136                                         my $str = <TMPFINDNAV>;
 137                                         $str =~ $regex
 138                                                 and push (@files, $File::Find::name);
 139                                         return;
 140                                 };
 141                         }
 142                         File::Find::find($wanted, $curdir);
 143
 144                          s:^./:: for @files;
 145
 146                         if(@files) {
 147                                 push @messages, errmsg("Found %s files.", scalar @files);
 148                                 $already_found = 1;
 149                         }
 150                         else {
 151                                 undef $full_path;
 152                                 push @errors, errmsg("No files found.");
 153                         }
 154                 }
 155         }
 156
 157         if($already_found) {
 158                 # do nothing
 159         }
 160         elsif($curdir eq '.') {
 161                 if($dir_mask eq '*') {
 162                         @files = grep $_ ne 'CVS', glob('*');
 163                 }
 164                 else {
 165                         @files = split /\s+/, $dir_mask;
 166                 }
 167         }
 168         else {
 169                 @files = grep $_ !~ m{/CVS$}, glob("$curdir/*");
 170         }
 171
 172         my $this_page = $Global::Variable->{MV_PAGE};
 173         my $this = Vend::Interpolate::tag_area($this_page);
 174         $this =~ s/\?(.*)//;
 175
 176         my $up_img = qq{<img src="up.gif" align=center border=0 height=22 width=20 title="upload ~FN~">};
 177         my $dn_img = qq{<img src="down.gif" align=center border=0 height=22 width=20 title="download ~FN~">};
 178         my $vw_img = qq{<img src="index.gif" align=center border=0 height=22 width=20 title="view ~FN~">};
 179         my $ed_img = qq{<img src="layout.gif" align=center border=0 height=22 width=20 title="edit ~FN~">};
 180         my $dir_img = qq{<img src="folder.gif" align=center border=0 height=22 width=20 title="change directory to ~FN~">};
 181         my $del_img = qq{<img src="delete.gif" align=center border=0 height=20 width=20 title="DELETE ~FN~">};
 182         my $sp_img = qq{<img src="bg.gif" align=center border=0 height=20 width=20>};
 183
 184         my $do_perms;
 185         $opt->{details} = $CGI->{details} unless defined $opt->{details};
 186         if(defined $opt->{details}) {
 187                 $do_perms = $opt->{details};
 188         }
 189         elsif (defined $CGI->{details}) {
 190                 $do_perms = $Session->{ui_file_details} = $CGI->{details};
 191         }
 192         else {
 193                 $do_perms = $Session->{ui_file_details};
 194         }
 195
 196         my $del_string = '';
 197         $Tag->if_mm('advanced', 'delete_files')
 198                 and do {
 199                         $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>};
 200                 };
 201
 202         my $ftmpl = <<EOF;
 203 <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>
 204 EOF
 205
 206         my $utmpl = <<EOF;
 207 <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>
 208 EOF
 209
 210         my $ftmpl_ed;
 211         if(! $do_perms and $opt->{edit_only}) {
 212                 $ftmpl_ed = <<EOF;
 213 <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>
 214 EOF
 215         }
 216         else {
 217                 $ftmpl_ed = <<EOF;
 218 <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>
 219 EOF
 220         }
 221
 222         my $dtmpl = <<EOF;
 223 <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>
 224 EOF
 225
 226         $dtmpl = "$sp_img$sp_img$sp_img$dtmpl" if $do_perms;
 227
 228         my @out;
 229         my $out;
 230
 231         my @dir;
 232         my @plain;
 233
 234
 235         sub perm_line {
 236                 my $fn = shift;
 237
 238                 my @perm = qw/
 239                         ---
 240                         --x
 241                         -w-
 242                         -wx
 243                         r--
 244                         r-x
 245                         rw-
 246                         rwx
 247                 /;
 248
 249                 my @det;
 250                 if (-l $fn) {
 251                         @det = lstat($fn);
 252                 }
 253                 else {
 254                         @det = stat(_);
 255                 }
 256                 my $time = POSIX::strftime("%d-%b-%Y %H:%M:%S", localtime($det[9]));
 257                 my $permstring = sprintf('%04o', $det[2]);
 258                 #push @messages, "$_ perms=$permstring\n";
 259                 $permstring = substr($permstring, -3, 3);
 260                 my $top;
 261                 my (@ugo) = split //, $permstring;
 262                 @ugo = map { $_ = $perm[$_] } @ugo;
 263                 if    (-l _) { $top = 'l' }
 264                 elsif (-d _) { $top = 'd' }
 265                 elsif (-f _) { $top = '-' }
 266                 else         { $top = '?' }
 267                 $ugo[0] =~ s/.$/s/ if $det[2] & S_ISUID();
 268                 $ugo[1] =~ s/.$/s/ if $det[2] & S_ISGID();
 269                 $ugo[2] =~ s/.$/t/ if $det[2] & S_ISVTX();
 270                 my $user = getpwuid($det[4]);
 271                 my $grp  = getgrgid($det[5]);
 272                 $grp = substr($grp, 0, 8) if length($grp) > 8;
 273                 $user = substr($grp, 0, 8) if length($user) > 8;
 274                 my $perm = join "", $top, @ugo;
 275                 my $ret = sprintf(" <TT><SMALL>%s %-8s %-8s %s</SMALL></TT>", $perm, $user, $grp, $time);
 276                 $ret =~ s/ /&nbsp;/g;
 277                 return $ret;
 278         }
 279
 280         my $perms = '';
 281         for(@files) {
 282                 my $fn = $_;
 283                 $fn =~ s:.*/::
 284                         unless $full_path;
 285                 my $fe = $_;
 286                 $fe =~ s!([^-\w./:,])!sprintf('%%%02x', ord($1) )!eg;
 287                 my $perms;
 288                 $perms = perm_line($_) if($do_perms);
 289
 290                 if(-d $_) {
 291                         push @dir, [$fe, $fn, $dtmpl, $perms];
 292                 }
 293                 elsif ($opt->{edit_all} || ($opt->{edit_only} && /\.html?$/) ) {
 294                         my $rn = $curdir . "/$fn";
 295                         $rn =~ s{$idir_re}{} if $idir_re;
 296                         push @plain, [$fe, $fn, $ftmpl_ed, $perms, $rn];
 297                 }
 298                 else {
 299                         push @plain, [$fe, $fn, $ftmpl, $perms];
 300                 }
 301         }
 302
 303         $opt->{top_of_tree} ||= '.';
 304         my $nd = $curdir;
 305         if($nd ne $opt->{top_of_tree} and ! $opt->{no_up}) {
 306                 $nd =~ s:/[^/]*$::
 307                   or $nd = $opt->{top_of_tree};
 308                 my $msg = '<large><b>..</b></large> &#91;'
 309                   . errmsg ($opt->{parent_directory_message} || 'parent directory')
 310                         . '&#93;';
 311                 unshift @dir, [ $nd, $msg, $dtmpl ];
 312         }
 313
 314         my $pc = \$Vend::Session->{pageCount};
 315         unshift @dir, [ "$curdir/", errmsg('(new file)'), $utmpl ]
 316                 unless $opt->{no_new_file};
 317
 318         @dir = () if $opt->{no_dirs};
 319
 320         for(@errors) {
 321                 $out .= "<span class=cerror>$_</span><br>";
 322         }
 323         for(@messages) {
 324                 $out .= "<span class=cmessage>$_</span><br>";
 325         }
 326         my $template = $opt->{template} || '';
 327         for (@dir, @plain) {
 328                 $$pc++;
 329                 $_->[2] = sprintf($_->[2], $_->[3], $_->[1]);
 330                 $_->[2] =~ s/~FN~/$_->[0]/g;
 331                 $_->[2] =~ s/~RN~/$_->[4]/g;
 332                 $_->[2] =~ s/~ID~/mv_session_id=$Session->{id}&mv_pc=$$pc/g;
 333                 if($template) {
 334                         my $t = $template;
 335                         $t =~ s/%s/$_->[2]/;
 336                         $out .= $t;
 337                 }
 338                 else {
 339                         $out .= $_->[2];
 340                 }
 341         }
 342
 343         return $out;
 344 }
 345 EOR