1# file-lib.pl 2# Common functions for file manager CGIs 3 4BEGIN { push(@INC, ".."); }; 5use WebminCore; 6&ReadParse(\%prein, 'GET'); 7if ($prein{'trust'}) { 8 &open_trust_db(); 9 if ($trustdb{$prein{'trust'}}) { 10 $trust_unknown_referers = 1; 11 $trustdb{$prein{'trust'}} = time(); 12 } 13 dbmclose(%trustdb); 14 } 15&init_config(); 16 17@file_buttons = ( "save", "preview", "edit", "info", "acl", "attr", "ext", 18 "search", "delete", "new", "upload", "mkdir", "makelink", 19 "rename", "sharing", "mount", "copy" ); 20 21if ($module_info{'usermin'}) { 22 # Usermin gets the allowed list from the module config 23 &switch_to_remote_user(); 24 &create_user_config_dirs(); 25 $hide_dot_files = $userconfig{'hide_dot_files'}; 26 $follow = int($config{'follow'}); 27 $real_home_dir = &simplify_path(&resolve_links($remote_user_info[7])); 28 $upload_max = $config{'max'}; 29 30 if ($config{'home_only'} == 1) { 31 @allowed_roots = ( $real_home_dir, 32 split(/\s+/, $config{'root'}) ); 33 } 34 elsif ($config{'home_only'} == 2) { 35 @allowed_roots = split(/\s+/, $config{'root'}); 36 } 37 else { 38 @allowed_roots = ( "/" ); 39 } 40 @denied_roots = split(/\s+/, $config{'noroot'}); 41 @allowed_roots = &expand_root_variables(@allowed_roots); 42 @denied_roots = &expand_root_variables(@denied_roots); 43 44 if ($config{'archive'} eq 'y') { 45 $archive = 1; 46 } 47 elsif ($config{'archive'} eq 'n') { 48 $archive = 0; 49 } 50 else { 51 $archive = 2; 52 $archmax = $config{'archive'}; 53 } 54 $unarchive = 1; 55 $dostounix = 1; 56 $chroot = "/"; 57 58 @disallowed_buttons = ( ); 59 foreach $k (keys %config) { 60 if ($k =~ /^button_(.*)/ && $config{$k} == 0) { 61 push(@disallowed_buttons, $1); 62 } 63 } 64 $canperms = 1; 65 $canusers = 1; 66 $contents = 1; 67 $running_as_root = 0; 68 } 69else { 70 # Webmin gets the list of allowed directories from the ACL 71 %access = &get_module_acl(); 72 $hide_dot_files = $config{'hide_dot_files'}; 73 $follow = int($access{'follow'}); 74 $upload_max = $access{'max'}; 75 76 @allowed_roots = split(/\s+/, $access{'root'}); 77 if ($access{'home'}) { 78 local @u = getpwnam($remote_user); 79 if (@u) { 80 push(@allowed_roots, 81 &simplify_path(&resolve_links($u[7]))); 82 } 83 } 84 @denied_roots = split(/\s+/, $access{'noroot'}); 85 86 $archive = $access{'archive'}; 87 $archmax = $access{'archmax'}; 88 $unarchive = $access{'unarchive'}; 89 $dostounix = $access{'dostounix'}; 90 $chroot = $access{'chroot'}; 91 $access{'button_search'} = 0 if (!&has_command("find")); 92 $access{'button_makelink'} = 0 if (!&supports_symlinks()); 93 $access{'button_info'} = 0 if (!&supports_users()); 94 95 @disallowed_buttons = grep { !$access{'button_'.$_} } @file_buttons; 96 if (&is_readonly_mode()) { 97 # Force read-only mode for file manager if global readonly 98 # is in effect. 99 $access{'ro'} = 1; 100 } 101 $canperms = $access{'noperms'} ? 0 : 1; 102 $canusers = $access{'nousers'} ? 0 : 1; 103 $contents = $access{'contents'}; 104 $running_as_root = !$access{'uid'}; 105 } 106%disallowed_buttons = map { $_, 1 } @disallowed_buttons; 107 108$icon_map = ( "c", 1, "txt", 1, 109 "pl", 1, "cgi", 1, 110 "html", 1, "htm", 1, 111 "gif", 2, "jpg", 2, 112 "tar", 3, "png", 2, 113 ); 114 115# file_info_line(path, [displaypath]) 116# Returns a line of text containing encoded details of some file 117sub file_info_line 118{ 119local @st; 120local $islink = (-l $_[0]); 121local $f = $islink && &must_follow($_[0]); 122local @st = $f ? stat($_[0]) : lstat($_[0]); 123local $ext = $_[0] =~ /\S+\.([^\.\/]+)$/ ? $1 : undef; 124local $dp = $_[1] || $_[0]; 125$dp =~ s/\\/\\\\/g; 126$dp =~ s/\t/\\t/g; 127return undef if ($dp =~ /\r|\n/); 128return undef if (!@st); 129local $type = $islink && !$f ? 5 : 130 -d _ ? 0 : 131 -b _ ? 6 : 132 -c _ ? 6 : 133 -p _ ? 7 : 134 -S _ ? 7 : defined($icon_map{$ext}) ? $icon_map{$ext} : 4; 135local $user = !&supports_users() ? "root" : 136 %uid_to_user ? $uid_to_user{$st[4]} : getpwuid($st[4]); 137$user = $st[4] if (!$user); 138local $group = !&supports_users() ? "root" : 139 %gid_to_group ? $gid_to_group{$st[5]} :getgrgid($st[5]); 140$group = $st[5] if (!$group); 141local $rl = readlink($_[0]); 142return join("\t", $dp, $type, 143 $user, $group, 144 $st[7] < 0 ? 2**32+$st[7] : $st[7], $st[2], 145 $st[9], $f ? "" : $islink && !$rl ? "???" : $rl); 146} 147 148# switch_acl_uid([user]) 149sub switch_acl_uid 150{ 151local ($user) = @_; 152return if ($module_info{'usermin'}); # Always already switched 153local @u = $user ? getpwnam($user) : 154 $access{'uid'} < 0 ? getpwnam($remote_user) : 155 getpwuid($access{'uid'}); 156if ($u[2]) { 157 @u || &error($text{'switch_euser'}); 158 &switch_to_unix_user(\@u); 159 umask(oct($access{'umask'})); 160 } 161} 162 163# switch_acl_uid_and_chroot() 164# Combines the switch_acl_uid and go_chroot functions 165sub switch_acl_uid_and_chroot 166{ 167if (!$module_info{'usermin'} && $access{'uid'}) { 168 local @u = $access{'uid'} < 0 ? getpwnam($remote_user) 169 : getpwuid($access{'uid'}); 170 @u || &error($text{'switch_euser'}); 171 local @other = &other_groups($u[0]); 172 &go_chroot(); 173 &switch_to_unix_user(\@u); 174 umask(oct($access{'umask'})); 175 } 176else { 177 &go_chroot(); 178 } 179} 180 181# can_access(file) 182# Returns 1 if some file can be edited/deleted 183sub can_access 184{ 185local ($file) = @_; 186$file =~ /^\// || return 0; 187local $path = &simplify_path($file); 188return &under_root_dir($path, \@allowed_roots) && 189 ($path eq "/" || !&under_root_dir($path, \@denied_roots)); 190} 191 192# under_root_dir(file, &roots) 193# Returns 1 if some file is under one of the given roots 194sub under_root_dir 195{ 196local $path = &simplify_path($_[0]); 197local $roots = $_[1]; 198local @f = grep { $_ ne '' } split(/\//, $path); 199local $r; 200DIR: foreach $r (@$roots) { 201 return 1 if ($r eq '/' || $path eq '/' || $path eq $r); 202 local @a = grep { $_ ne '' } split(/\//, $r); 203 local $i; 204 for($i=0; $i<@a; $i++) { 205 next DIR if ($a[$i] ne $f[$i]); 206 } 207 return 1; 208 } 209return 0; 210} 211 212# can_list(dir) 213# Returns 1 if some directory can be listed. Parent directories of allowed 214# directories are included as well. 215sub can_list 216{ 217local $path = &simplify_path($_[0]); 218return &under_root_dir_or_parent($path, \@allowed_roots) && 219 ($path eq "/" || !&under_root_dir($path, \@denied_roots)); 220} 221 222# under_root_dir_or_parent(file, &roots) 223# Returns 1 if some file is under one of the given roots, or their parents 224sub under_root_dir_or_parent 225{ 226local @f = grep { $_ ne '' } split(/\//, $_[0]); 227DIR: foreach $r (@allowed_roots) { 228 return 1 if ($r eq '/' || $_[0] eq '/' || $_[0] eq $r); 229 local @a = grep { $_ ne '' } split(/\//, $r); 230 local $i; 231 for($i=0; $i<@a && $i<@f; $i++) { 232 next DIR if ($a[$i] ne $f[$i]); 233 } 234 return 1; 235 } 236return 0; 237} 238 239# accessible_subdir(dir) 240# Returns the path to a dir under the given one that we can access 241sub accessible_subdir 242{ 243local ($r, @rv); 244foreach $r (@allowed_roots) { 245 if ($r =~ /^(\Q$_[0]\E\/[^\/]+)/) { 246 push(@rv, $1); 247 } 248 } 249return @rv; 250} 251 252sub open_trust_db 253{ 254local $trust = $ENV{'WEBMIN_CONFIG'} =~ /\/usermin/ ? 255 "/tmp/trust.$ENV{'REMOTE_USER'}" : 256 "$ENV{'WEBMIN_CONFIG'}/file/trust"; 257eval "use SDBM_File"; 258dbmopen(%trustdb, $trust, 0700); 259eval { $trustdb{'1111111111'} = 'foo bar' }; 260if ($@) { 261 dbmclose(%trustdb); 262 eval "use NDBM_File"; 263 dbmopen(%trustdb, $trust, 0700); 264 } 265} 266 267# must_follow(path) 268# For symlinks, returns 1 if a link should be follow, 0 if not 269sub must_follow 270{ 271if ($follow == 1) { 272 return 1; 273 } 274elsif ($follow == 0) { 275 return 0; 276 } 277else { 278 local @s = stat($_[0]); 279 local @l = lstat($_[0]); 280 @st = ($s[4] == $l[4] ? @s : @l); 281 return $s[4] == $l[4]; 282 } 283} 284 285# extract_archive(path, delete-after, get-contents) 286# Called by upload to extract some zip or tar.gz file. Returns undef if 287# something was actually done, an error message otherwise. 288sub extract_archive 289{ 290local ($path, $delete, $contents) = @_; 291local $out; 292$path =~ /^(\S*\/)/ || return 0; 293local $dir = $1; 294local $qdir = quotemeta($dir); 295local $qpath = quotemeta($path); 296if ($path =~ /\.zip$/i) { 297 # Extract zip file 298 return &text('zip_ecmd', "unzip") if (!&has_command("unzip")); 299 if ($contents) { 300 $out = `(cd $qdir; unzip -l $qpath) 2>&1 </dev/null`; 301 } 302 else { 303 $out = `(cd $qdir; unzip -o $qpath) 2>&1 </dev/null`; 304 } 305 if ($?) { 306 return &text('zip_eunzip', $out); 307 } 308 } 309elsif ($path =~ /\.tar$/i) { 310 # Extract un-compressed tar file 311 return &text('zip_ecmd', "tar") if (!&has_command("tar")); 312 if ($contents) { 313 $out = `(cd $qdir; tar tf $qpath) 2>&1 </dev/null`; 314 } 315 else { 316 $out = `(cd $qdir; tar xf $qpath) 2>&1 </dev/null`; 317 } 318 if ($?) { 319 return &text('zip_euntar', $out); 320 } 321 } 322elsif ($path =~ /\.(tar\.gz|tgz|tar\.bz|tbz|tar\.bz2|tbz2)$/i) { 323 # Extract gzip or bzip2-compressed tar file 324 local $zipper = $_[0] =~ /bz(2?)$/i ? "bunzip2" 325 : "gunzip"; 326 return &text('zip_ecmd', "tar") if (!&has_command("tar")); 327 return &text('zip_ecmd', $zipper) if (!&has_command($zipper)); 328 if ($contents) { 329 $out = `(cd $qdir; $zipper -c $qpath | tar tf -) 2>&1`; 330 } 331 else { 332 $out = `(cd $qdir; $zipper -c $qpath | tar xf -) 2>&1`; 333 } 334 if ($?) { 335 return &text('zip_euntar2', $out); 336 } 337 } 338elsif ($path =~ /\.gz$/i) { 339 # Uncompress gzipped file 340 return &text('zip_ecmd', "gunzip") if (!&has_command("gunzip")); 341 local $final = $_[0]; 342 $final =~ s/\.gz$//; 343 local $qfinal = quotemeta($final); 344 if ($contents) { 345 $out = $final; 346 $out =~ s/^.*\///; 347 } 348 else { 349 $out = `(cd $qdir; gunzip -c $qpath >$qfinal) 2>&1`; 350 } 351 if ($?) { 352 return &text('zip_euntar2', $out); 353 } 354 } 355else { 356 return $text{'zip_ename'}; 357 } 358if ($contents) { 359 return (undef, split(/\r?\n/, $out)); 360 } 361elsif ($delete) { 362 unlink($path); 363 } 364return undef; 365} 366 367# post_upload(path, dir, unzip) 368sub post_upload 369{ 370local ($path, $dir, $zip) = @_; 371if ($unarchive == 2) { 372 $zip = $path =~ /\.(zip|tgz|tar|tar\.gz)$/i ? 1 : 0; 373 } 374elsif ($unarchive == 0) { 375 $zip = 0; 376 } 377local $refresh = $path; 378local $err; 379if ($zip) { 380 $err = &extract_archive(&unmake_chroot($path), $zip-1); 381 if (!$err) { 382 # Refresh whole dir 383 $refresh = $dir; 384 } 385 } 386$info = &file_info_line(&unmake_chroot($refresh), $refresh); 387print "<script>\n"; 388print "try {\n"; 389print " opener.document.FileManager.", 390 "upload_notify(\""."e_escape($refresh)."\", ", 391 "\""."e_escape($info)."\");\n"; 392print "} catch(err) { }\n"; 393if ($err) { 394 $err =~ s/\r//g; 395 $err =~ s/\n/\\n/g; 396 print "opener.document.FileManager.", 397 "upload_error(\"","e_escape(&text('zip_err', $err)),"\");\n"; 398 } 399print "close();\n"; 400print "</script>\n"; 401} 402 403sub go_chroot 404{ 405if ($chroot ne "/" && $chroot ne "") { 406 # First build hash of users and groups, which will not be accessible 407 # after a chroot 408 local (@u, @g); 409 setpwent(); 410 while(@u = getpwent()) { 411 $uid_to_user{$u[2]} = $u[0] if (!defined($uid_to_user{$u[2]})); 412 $user_to_uid{$u[0]} = $u[2] if (!defined($user_to_uid{$u[0]})); 413 } 414 endpwent(); 415 setgrent(); 416 while(@g = getgrent()) { 417 $gid_to_group{$g[2]} = $g[0] if(!defined($gid_to_group{$g[2]})); 418 $group_to_gid{$g[0]} = $g[2] if(!defined($group_to_gid{$g[0]})); 419 } 420 endgrent(); 421 chroot($chroot) || die("chroot to $chroot failed"); 422 } 423} 424 425# make_chroot(dir) 426# Converts some real directory to the chroot form 427sub make_chroot 428{ 429if ($chroot eq "/") { 430 return $_[0]; 431 } 432elsif ($_[0] eq $chroot) { 433 return "/"; 434 } 435else { 436 local $rv = $_[0]; 437 if ($rv =~ /^$chroot\//) { 438 $rv =~ s/^$chroot//; 439 return $rv; 440 } 441 else { 442 return undef; 443 } 444 } 445} 446 447# unmake_chroot(dir) 448# Converts some chroot'd directory to the real form 449sub unmake_chroot 450{ 451if ($chroot eq "/") { 452 return $_[0]; 453 } 454elsif ($_[0] eq "/") { 455 return $chroot; 456 } 457else { 458 return $chroot.$_[0]; 459 } 460} 461 462# print_content_type([type]) 463# Prints the content-type header, with a charset 464sub print_content_type 465{ 466local $type = $_[0] || "text/plain"; 467if ($userconfig{'nocharset'} || $config{'nocharset'}) { 468 # Never try to use charset 469 print "Content-type: $type\n\n"; 470 } 471else { 472 my $charset = &get_charset(); 473 print "Content-type: $type; charset=$charset\n\n"; 474 } 475} 476 477# html_extract_head_body(html) 478# Given some HTML, extracts the header, body and stuff after the body 479sub html_extract_head_body 480{ 481local ($html) = @_; 482if ($html =~ /^([\000-\377]*<body[^>]*>)([\000-\377]*)(<\/body[^>]*>[\000-\377]*)/i) { 483 return ($1, $2, $3); 484 } 485else { 486 return (undef, $html, undef); 487 } 488} 489 490# expand_root_variables(dir, ...) 491# Replaces $USER and $HOME in a list of dirs 492sub expand_root_variables 493{ 494local @rv; 495local %hash = ( 'user' => $remote_user_info[0], 496 'home' => $remote_user_info[7], 497 'uid' => $remote_user_info[2], 498 'gid' => $remote_user_info[3] ); 499my @ginfo = getgrgid($remote_user_info[3]); 500$hash{'group'} = $ginfo[0]; 501foreach my $dir (@_) { 502 push(@rv, &substitute_template($dir, \%hash)); 503 } 504return @rv; 505} 506 5071; 508 509