sub read_file
{
local $_;
-local $split = defined($_[4]) ? $_[4] : "=";
-local $realfile = &translate_filename($_[0]);
+my $split = defined($_[4]) ? $_[4] : "=";
+my $realfile = &translate_filename($_[0]);
&open_readfile(ARFILE, $_[0]) || return 0;
while(<ARFILE>) {
chomp;
- local $hash = index($_, "#");
- local $eq = index($_, $split);
+ my $hash = index($_, "#");
+ my $eq = index($_, $split);
if ($hash != 0 && $eq >= 0) {
- local $n = substr($_, 0, $eq);
- local $v = substr($_, $eq+1);
+ my $n = substr($_, 0, $eq);
+ my $v = substr($_, $eq+1);
chomp($v);
$_[1]->{$_[3] ? lc($n) : $n} = $v;
push(@{$_[2]}, $n) if ($_[2]);
=cut
sub read_file_cached
{
-local $realfile = &translate_filename($_[0]);
+my $realfile = &translate_filename($_[0]);
if (defined($main::read_file_cache{$realfile})) {
# Use cached data
%{$_[1]} = ( %{$_[1]}, %{$main::read_file_cache{$realfile}} );
}
else {
# Actually read the file
- local %d;
+ my %d;
if (&read_file($_[0], \%d, $_[2], $_[3], $_[4])) {
%{$main::read_file_cache{$realfile}} = %d;
%{$_[1]} = ( %{$_[1]}, %d );
=cut
sub write_file
{
-local(%old, @order);
-local $join = defined($_[2]) ? $_[2] : "=";
-local $realfile = &translate_filename($_[0]);
+my (%old, @order);
+my $join = defined($_[2]) ? $_[2] : "=";
+my $realfile = &translate_filename($_[0]);
&read_file($_[0], \%old, \@order);
&open_tempfile(ARFILE, ">$_[0]");
foreach $k (@order) {
=cut
sub html_escape
{
-local $tmp = $_[0];
+my ($tmp) = @_;
$tmp =~ s/&/&/g;
$tmp =~ s/</</g;
$tmp =~ s/>/>/g;
=cut
sub quote_escape
{
-local ($tmp, $only) = @_;
+my ($tmp, $only) = @_;
if ($tmp !~ /\&[a-zA-Z]+;/ && $tmp !~ /\&#/) {
# convert &, unless it is part of &#nnn; or &foo;
$tmp =~ s/&([^#])/&$1/g;
=cut
sub tempname
{
-local $tmp_base = $gconfig{'tempdir_'.$module_name} ?
- $gconfig{'tempdir_'.$module_name} :
+my $tmp_base = $gconfig{'tempdir_'.&get_module_name()} ?
+ $gconfig{'tempdir_'.&get_module_name()} :
$gconfig{'tempdir'} ? $gconfig{'tempdir'} :
$ENV{'TEMP'} ? $ENV{'TEMP'} :
$ENV{'TMP'} ? $ENV{'TMP'} :
-d "c:/temp" ? "c:/temp" : "/tmp/.webmin";
-local $tmp_dir = -d $remote_user_info[7] && !$gconfig{'nohometemp'} ?
+my $tmp_dir = -d $remote_user_info[7] && !$gconfig{'nohometemp'} ?
"$remote_user_info[7]/.tmp" :
@remote_user_info ? $tmp_base."-".$remote_user :
$< != 0 ? $tmp_base."-".getpwuid($<) :
}
else {
# On Unix systems, need to make sure temp dir is valid
- local $tries = 0;
+ my $tries = 0;
while($tries++ < 10) {
- local @st = lstat($tmp_dir);
+ my @st = lstat($tmp_dir);
last if ($st[4] == $< && (-d _) && ($st[2] & 0777) == 0755);
if (@st) {
unlink($tmp_dir) || rmdir($tmp_dir) ||
chmod(0755, $tmp_dir);
}
if ($tries >= 10) {
- local @st = lstat($tmp_dir);
+ my @st = lstat($tmp_dir);
&error("Failed to create temp directory $tmp_dir : uid=$st[4] mode=$st[2]");
}
}
-local $rv;
+my $rv;
if (defined($_[0]) && $_[0] !~ /\.\./) {
$rv = "$tmp_dir/$_[0]";
}
=cut
sub transname
{
-local $rv = &tempname(@_);
+my $rv = &tempname(@_);
push(@main::temporary_files, $rv);
return $rv;
}
given width. Useful for word wrapping.
=cut
-sub trunc {
- local($str,$c);
- if (length($_[0]) <= $_[1])
- { return $_[0]; }
- $str = substr($_[0],0,$_[1]);
- do {
- $c = chop($str);
- } while($c !~ /\S/);
- $str =~ s/\s+$//;
- return $str;
+sub trunc
+{
+if (length($_[0]) <= $_[1]) {
+ return $_[0];
+ }
+my $str = substr($_[0],0,$_[1]);
+my $c;
+do {
+ $c = chop($str);
+ } while($c !~ /\S/);
+$str =~ s/\s+$//;
+return $str;
}
=head2 indexof(string, value, ...)
found.
=cut
-sub indexof {
- local($i);
- for($i=1; $i <= $#_; $i++) {
- if ($_[$i] eq $_[0]) { return $i - 1; }
- }
- return -1;
+sub indexof
+{
+for(my $i=1; $i <= $#_; $i++) {
+ if ($_[$i] eq $_[0]) { return $i - 1; }
+ }
+return -1;
}
=head2 indexoflc(string, value, ...)
=cut
sub indexoflc
{
-local $str = lc(shift(@_));
-local @arr = map { lc($_) } @_;
+my $str = lc(shift(@_));
+my @arr = map { lc($_) } @_;
return &indexof($str, @arr);
}
=cut
sub sysprint
{
-local($str, $fh);
-$str = join('', @_[1..$#_]);
-$fh = $_[0];
+my $fh = $_[0];
+my $str = join('', @_[1..$#_]);
syswrite $fh, $str, length($str);
}
=cut
sub check_ip6address
{
- local @blocks = split(/:/, $_[0]);
+ my @blocks = split(/:/, $_[0]);
return 0 if (@blocks == 0 || @blocks > 8);
# The address/netmask format is accepted. So we're looking for a "/" to isolate a possible netmask.
# After that, we delete the netmask to control the address only format, but we verify whether the netmask
# value is in [0;128].
- local $ib = $#blocks;
- local $where = index($blocks[$ib],"/");
- local $m=0;
+ my $ib = $#blocks;
+ my $where = index($blocks[$ib],"/");
+ my $m = 0;
if ($where != -1) {
- local $b = substr($blocks[$ib],0,$where);
+ my $b = substr($blocks[$ib],0,$where);
$m = substr($blocks[$ib],$where+1,length($blocks[$ib])-($where+1));
$blocks[$ib]=$b;
}
# Check the different blocks of the address : 16 bits block in hexa notation.
# Possibility of 1 empty block or 2 if the address begins with "::".
- local $b;
- local $empty = 0;
+ my $b;
+ my $empty = 0;
foreach $b (@blocks) {
return 0 if ($b ne "" && $b !~ /^[0-9a-f]{1,4}$/i);
$empty++ if ($b eq "");
&theme_generate_icon(@_);
return;
}
-local $w = !defined($_[4]) ? "width=48" : $_[4] ? "width=$_[4]" : "";
-local $h = !defined($_[5]) ? "height=48" : $_[5] ? "height=$_[5]" : "";
+my $w = !defined($_[4]) ? "width=48" : $_[4] ? "width=$_[4]" : "";
+my $h = !defined($_[5]) ? "height=48" : $_[5] ? "height=$_[5]" : "";
if ($tconfig{'noicons'}) {
if ($_[2]) {
print "$_[6]<a href=\"$_[2]\" $_[3]>$_[1]</a>$_[7]\n";
Converts a string to a form ok for putting in a URL, using % escaping.
=cut
-sub urlize {
- local $rv = $_[0];
- $rv =~ s/([^A-Za-z0-9])/sprintf("%%%2.2X", ord($1))/ge;
- return $rv;
+sub urlize
+{
+my ($rv) = @_;
+$rv =~ s/([^A-Za-z0-9])/sprintf("%%%2.2X", ord($1))/ge;
+return $rv;
}
=head2 un_urlize(string)
=cut
sub un_urlize
{
-local $rv = $_[0];
+my ($rv) = @_;
$rv =~ s/\+/ /g;
$rv =~ s/%(..)/pack("c",hex($1))/ge;
return $rv;
=cut
sub copydata
{
-local ($buf, $out, $in);
-$out = $_[1];
-$in = $_[0];
+my ($in, $out) = @_;
+my $buf;
while(read($in, $buf, 1024) > 0) {
(print $out $buf) || return 0;
}
=cut
sub ReadParseMime
{
-local ($max, $cbfunc, $cbargs) = @_;
-local ($boundary, $line, $foo, $name, $got, $file);
-local $err = &text('readparse_max', $max);
+my ($max, $cbfunc, $cbargs) = @_;
+my ($boundary, $line, $foo, $name, $got, $file);
+my $err = &text('readparse_max', $max);
$ENV{'CONTENT_TYPE'} =~ /boundary=(.*)$/ || &error($text{'readparse_enc'});
if ($ENV{'CONTENT_LENGTH'} && $max && $ENV{'CONTENT_LENGTH'} > $max) {
&error($err);
while(1) {
$name = "";
# Read section headers
- local $lastheader;
+ my $lastheader;
while(1) {
$line = <STDIN>;
$got += length($line);
if ($cbfunc);
return;
}
- local $ptline = $line;
+ my $ptline = $line;
$ptline =~ s/[^a-zA-Z0-9\-]/\./g;
if (index($line, $boundary) != -1) { last; }
$in{$name} .= $line;
=cut
sub ReadParse
{
-local $a = $_[0] ? $_[0] : \%in;
+my $a = $_[0] || \%in;
%$a = ( );
-local $i;
-local $meth = $_[1] ? $_[1] : $ENV{'REQUEST_METHOD'};
+my $meth = $_[1] ? $_[1] : $ENV{'REQUEST_METHOD'};
undef($in);
if ($meth eq 'POST') {
- local $clen = $ENV{'CONTENT_LENGTH'};
+ my $clen = $ENV{'CONTENT_LENGTH'};
&read_fully(STDIN, \$in, $clen) == $clen ||
&error("Failed to read POST input : $!");
}
else { $in = $ENV{'QUERY_STRING'}; }
}
@in = split(/\&/, $in);
-foreach $i (@in) {
- local ($k, $v) = split(/=/, $i, 2);
+foreach my $i (@in) {
+ my ($k, $v) = split(/=/, $i, 2);
if (!$_[2]) {
$k =~ tr/\+/ /;
$v =~ tr/\+/ /;
=cut
sub read_fully
{
-local ($fh, $buf, $len) = @_;
-local $got = 0;
+my ($fh, $buf, $len) = @_;
+my $got = 0;
while($got < $len) {
my $r = read(STDIN, $$buf, $len-$got, $got);
last if ($r <= 0);
=cut
sub read_parse_mime_callback
{
-local ($size, $totalsize, $filename, $id) = @_;
+my ($size, $totalsize, $filename, $id) = @_;
return if ($gconfig{'no_upload_tracker'});
return if (!$id);
# Create the upload tracking directory - if running as non-root, this has to
# be under the user's home
-local $vardir;
+my $vardir;
if ($<) {
- local @uinfo = @remote_user_info ? @remote_user_info : getpwuid($<);
+ my @uinfo = @remote_user_info ? @remote_user_info : getpwuid($<);
$vardir = "$uinfo[7]/.tmp";
}
else {
# Remove any upload.* files more than 1 hour old
if (!$main::read_parse_mime_callback_flushed) {
- local $now = time();
+ my $now = time();
opendir(UPDIR, $vardir);
foreach my $f (readdir(UPDIR)) {
next if ($f !~ /^upload\./);
- local @st = stat("$vardir/$f");
+ my @st = stat("$vardir/$f");
if ($st[9] < $now-3600) {
unlink("$vardir/$f");
}
}
# Only update file once per percent
-local $upfile = "$vardir/upload.$id";
+my $upfile = "$vardir/upload.$id";
if ($totalsize && $size >= 0) {
- local $pc = int(100 * $size / $totalsize);
+ my $pc = int(100 * $size / $totalsize);
if ($pc <= $main::read_parse_mime_callback_pc{$upfile}) {
return;
}
=cut
sub read_parse_mime_javascript
{
-local ($id, $fields) = @_;
+my ($id, $fields) = @_;
return "" if ($gconfig{'no_upload_tracker'});
-local $opener = "window.open(\"$gconfig{'webprefix'}/uptracker.cgi?id=$id&uid=$<\", \"uptracker\", \"toolbar=no,menubar=no,scrollbars=no,width=500,height=100\");";
+my $opener = "window.open(\"$gconfig{'webprefix'}/uptracker.cgi?id=$id&uid=$<\", \"uptracker\", \"toolbar=no,menubar=no,scrollbars=no,width=500,height=100\");";
if ($fields) {
- local $if = join(" || ", map { "typeof($_) != \"undefined\" && $_.value != \"\"" } @$fields);
+ my $if = join(" || ", map { "typeof($_) != \"undefined\" && $_.value != \"\"" } @$fields);
return "onSubmit='if ($if) { $opener }'";
}
else {
sub header
{
return if ($main::done_webmin_header++);
-local $ll;
-local $charset = defined($force_charset) ? $force_charset : &get_charset();
+my $ll;
+my $charset = defined($force_charset) ? $force_charset : &get_charset();
&PrintHeader($charset);
&load_theme_library();
if (defined(&theme_header)) {
"content=\"text/html; Charset=$charset\">\n";
}
if (@_ > 0) {
- local $title = &get_html_title($_[0]);
+ my $title = &get_html_title($_[0]);
print "<title>$title</title>\n";
print $_[7] if ($_[7]);
print &get_html_status_line(0);
close(INC);
}
print "</head>\n";
-local $bgcolor = defined($tconfig{'cs_page'}) ? $tconfig{'cs_page'} :
+my $bgcolor = defined($tconfig{'cs_page'}) ? $tconfig{'cs_page'} :
defined($gconfig{'cs_page'}) ? $gconfig{'cs_page'} : "ffffff";
-local $link = defined($tconfig{'cs_link'}) ? $tconfig{'cs_link'} :
+my $link = defined($tconfig{'cs_link'}) ? $tconfig{'cs_link'} :
defined($gconfig{'cs_link'}) ? $gconfig{'cs_link'} : "0000ee";
-local $text = defined($tconfig{'cs_text'}) ? $tconfig{'cs_text'} :
+my $text = defined($tconfig{'cs_text'}) ? $tconfig{'cs_text'} :
defined($gconfig{'cs_text'}) ? $gconfig{'cs_text'} : "000000";
-local $bgimage = defined($tconfig{'bgimage'}) ? "background=$tconfig{'bgimage'}"
+my $bgimage = defined($tconfig{'bgimage'}) ? "background=$tconfig{'bgimage'}"
: "";
-local $dir = $current_lang_info->{'dir'} ? "dir=\"$current_lang_info->{'dir'}\""
+my $dir = $current_lang_info->{'dir'} ? "dir=\"$current_lang_info->{'dir'}\""
: "";
print "<body bgcolor=#$bgcolor link=#$link vlink=#$link text=#$text ",
"$bgimage $tconfig{'inbody'} $dir $_[8]>\n";
if (defined(&theme_prebody)) {
&theme_prebody(@_);
}
-local $hostname = &get_display_hostname();
-local $version = &get_webmin_version();
-local $prebody = $tconfig{'prebody'};
+my $hostname = &get_display_hostname();
+my $version = &get_webmin_version();
+my $prebody = $tconfig{'prebody'};
if ($prebody) {
$prebody =~ s/%HOSTNAME%/$hostname/g;
$prebody =~ s/%VERSION%/$version/g;
}
if (@_ > 1) {
print $tconfig{'preheader'};
+ my %this_module_info = &get_module_info(&get_module_name());
print "<table class='header' width=100%><tr>\n";
if ($gconfig{'sysinfo'} == 2 && $remote_user) {
print "<td id='headln1' colspan=3 align=center>\n";
"$text{'header_servers'}</a><br>\n";
}
if (!$_[5] && !$tconfig{'noindex'}) {
- local @avail = &get_available_module_infos(1);
- local $nolo = $ENV{'ANONYMOUS_USER'} ||
+ my @avail = &get_available_module_infos(1);
+ my $nolo = $ENV{'ANONYMOUS_USER'} ||
$ENV{'SSL_USER'} || $ENV{'LOCAL_USER'} ||
$ENV{'HTTP_USER_AGENT'} =~ /webmin/i;
if ($gconfig{'gotoone'} && $main::session_id && @avail == 1 &&
"$text{'main_switch'}</a><br>";
}
elsif (!$gconfig{'gotoone'} || @avail > 1) {
- print "<a href='$gconfig{'webprefix'}/?cat=$module_info{'category'}'>",
- "$text{'header_webmin'}</a><br>\n";
+ print "<a href='$gconfig{'webprefix'}/?cat=",
+ $this_module_info{'category'},
+ "'>$text{'header_webmin'}</a><br>\n";
}
}
if (!$_[4] && !$tconfig{'nomoduleindex'}) {
- local $idx = $module_info{'index_link'};
- local $mi = $module_index_link || "/$module_name/$idx";
- local $mt = $module_index_name || $text{'header_module'};
+ my $idx = $this_module_info{'index_link'};
+ my $mi = $module_index_link || "/".&get_module_name()."/$idx";
+ my $mt = $module_index_name || $text{'header_module'};
print "<a href=\"$gconfig{'webprefix'}$mi\">$mt</a><br>\n";
}
if (ref($_[2]) eq "ARRAY" && !$ENV{'ANONYMOUS_USER'} &&
print &hlink($text{'header_help'}, $_[2]),"<br>\n";
}
if ($_[3]) {
- local %access = &get_module_acl();
+ my %access = &get_module_acl();
if (!$access{'noconfig'} && !$config{'noprefs'}) {
- local $cprog = $user_module_config_directory ?
+ my $cprog = $user_module_config_directory ?
"uconfig.cgi" : "config.cgi";
- print "<a href=\"$gconfig{'webprefix'}/$cprog?$module_name\">",
+ print "<a href=\"$gconfig{'webprefix'}/$cprog?",
+ &get_module_name()."\">",
$text{'header_config'},"</a><br>\n";
}
}
}
else {
# Title is just text
- local $ts = defined($tconfig{'titlesize'}) ?
+ my $ts = defined($tconfig{'titlesize'}) ?
$tconfig{'titlesize'} : "+2";
print "<td id='headln2c' align=center width=70%>",
($ts ? "<font size=$ts>" : ""),$_[0],
=cut
sub get_html_title
{
-local ($msg) = @_;
-local $title;
-local $os_type = $gconfig{'real_os_type'} ? $gconfig{'real_os_type'}
- : $gconfig{'os_type'};
-local $os_version = $gconfig{'real_os_version'} ? $gconfig{'real_os_version'}
- : $gconfig{'os_version'};
+my ($msg) = @_;
+my $title;
+my $os_type = $gconfig{'real_os_type'} || $gconfig{'os_type'};
+my $os_version = $gconfig{'real_os_version'} || $gconfig{'os_version'};
if ($gconfig{'sysinfo'} == 1 && $remote_user) {
$title = sprintf "%s : %s on %s (%s %s)\n",
$msg, $remote_user, &get_display_hostname(),
=cut
sub get_html_framed_title
{
-local $ostr;
-local $os_type = $gconfig{'real_os_type'} ? $gconfig{'real_os_type'}
- : $gconfig{'os_type'};
-local $os_version = $gconfig{'real_os_version'} ? $gconfig{'real_os_version'}
- : $gconfig{'os_version'};
-local $title;
+my $ostr;
+my $os_type = $gconfig{'real_os_type'} || $gconfig{'os_type'};
+my $os_version = $gconfig{'real_os_version'} || $gconfig{'os_version'};
+my $title;
if (($gconfig{'sysinfo'} == 4 || $gconfig{'sysinfo'} == 1) && $remote_user) {
# Alternate title mode requested
$title = sprintf "%s on %s (%s %s)\n",
else {
$ostr = "$os_type $os_version";
}
- local $host = &get_display_hostname();
+ my $host = &get_display_hostname();
$title = $gconfig{'nohostname'} ? $text{'main_title2'} :
&text('main_title', &get_webmin_version(), $host, $ostr);
if ($gconfig{'showlogin'}) {
=cut
sub get_html_status_line
{
-local ($textonly) = @_;
+my ($textonly) = @_;
if (($gconfig{'sysinfo'} != 0 || !$remote_user) && !$textonly) {
# Disabled in this mode
return undef;
}
-local $os_type = $gconfig{'real_os_type'} ? $gconfig{'real_os_type'}
- : $gconfig{'os_type'};
-local $os_version = $gconfig{'real_os_version'} ? $gconfig{'real_os_version'}
- : $gconfig{'os_version'};
-local $line = &text('header_statusmsg',
- ($ENV{'ANONYMOUS_USER'} ? "Anonymous user"
+my $os_type = $gconfig{'real_os_type'} || $gconfig{'os_type'};
+my $os_version = $gconfig{'real_os_version'} || $gconfig{'os_version'};
+my $line = &text('header_statusmsg',
+ ($ENV{'ANONYMOUS_USER'} ? "Anonymous user"
: $remote_user).
- ($ENV{'SSL_USER'} ? " (SSL certified)" :
- $ENV{'LOCAL_USER'} ? " (Local user)" : ""),
- $text{'programname'},
- &get_webmin_version(),
- &get_display_hostname(),
- $os_type.($os_version eq "*" ? "" :" $os_version"));
+ ($ENV{'SSL_USER'} ? " (SSL certified)" :
+ $ENV{'LOCAL_USER'} ? " (Local user)" : ""),
+ $text{'programname'},
+ &get_webmin_version(),
+ &get_display_hostname(),
+ $os_type.($os_version eq "*" ? "" :" $os_version"));
if ($textonly) {
return $line;
}
sub popup_header
{
return if ($main::done_webmin_header++);
-local $ll;
-local $charset = defined($force_charset) ? $force_charset : &get_charset();
+my $ll;
+my $charset = defined($force_charset) ? $force_charset : &get_charset();
&PrintHeader($charset);
&load_theme_library();
if (defined(&theme_popup_header)) {
close(INC);
}
print "</head>\n";
-local $bgcolor = defined($tconfig{'cs_page'}) ? $tconfig{'cs_page'} :
+my $bgcolor = defined($tconfig{'cs_page'}) ? $tconfig{'cs_page'} :
defined($gconfig{'cs_page'}) ? $gconfig{'cs_page'} : "ffffff";
-local $link = defined($tconfig{'cs_link'}) ? $tconfig{'cs_link'} :
+my $link = defined($tconfig{'cs_link'}) ? $tconfig{'cs_link'} :
defined($gconfig{'cs_link'}) ? $gconfig{'cs_link'} : "0000ee";
-local $text = defined($tconfig{'cs_text'}) ? $tconfig{'cs_text'} :
+my $text = defined($tconfig{'cs_text'}) ? $tconfig{'cs_text'} :
defined($gconfig{'cs_text'}) ? $gconfig{'cs_text'} : "000000";
-local $bgimage = defined($tconfig{'bgimage'}) ? "background=$tconfig{'bgimage'}"
+my $bgimage = defined($tconfig{'bgimage'}) ? "background=$tconfig{'bgimage'}"
: "";
print "<body id='popup' bgcolor=#$bgcolor link=#$link vlink=#$link ",
"text=#$text $bgimage $tconfig{'inbody'} $_[2]>\n";
&theme_footer(@_);
return;
}
-local $i;
-for($i=0; $i+1<@_; $i+=2) {
- local $url = $_[$i];
+local %this_module_info = &get_module_info(&get_module_name());
+for(my $i=0; $i+1<@_; $i+=2) {
+ my $url = $_[$i];
if ($url ne '/' || !$tconfig{'noindex'}) {
if ($url eq '/') {
- $url = "/?cat=$module_info{'category'}";
+ $url = "/?cat=$this_module_info{'category'}";
}
- elsif ($url eq '' && $module_name) {
- $url = "/$module_name/$module_info{'index_link'}";
+ elsif ($url eq '' && &get_module_name()) {
+ $url = "/".&get_module_name()."/".
+ $this_module_info{'index_link'};
}
- elsif ($url =~ /^\?/ && $module_name) {
- $url = "/$module_name/$url";
+ elsif ($url =~ /^\?/ && &get_module_name()) {
+ $url = "/".&get_module_name()."/$url";
}
$url = "$gconfig{'webprefix'}$url" if ($url =~ /^\//);
if ($i == 0) {
}
print "<br>\n";
if (!$_[$i]) {
- local $postbody = $tconfig{'postbody'};
+ my $postbody = $tconfig{'postbody'};
if ($postbody) {
- local $hostname = &get_display_hostname();
- local $version = &get_webmin_version();
- local $os_type = $gconfig{'real_os_type'} ?
- $gconfig{'real_os_type'} : $gconfig{'os_type'};
- local $os_version = $gconfig{'real_os_version'} ?
- $gconfig{'real_os_version'} : $gconfig{'os_version'};
+ my $hostname = &get_display_hostname();
+ my $version = &get_webmin_version();
+ my $os_type = $gconfig{'real_os_type'} ||
+ $gconfig{'os_type'};
+ my $os_version = $gconfig{'real_os_version'} ||
+ $gconfig{'os_version'};
$postbody =~ s/%HOSTNAME%/$hostname/g;
$postbody =~ s/%VERSION%/$version/g;
$postbody =~ s/%USER%/$remote_user/g;
=cut
sub redirect
{
-local($port, $prot, $url);
-$port = $ENV{'SERVER_PORT'} == 443 && uc($ENV{'HTTPS'}) eq "ON" ? "" :
- $ENV{'SERVER_PORT'} == 80 && uc($ENV{'HTTPS'}) ne "ON" ? "" :
+my $port = $ENV{'SERVER_PORT'} == 443 && uc($ENV{'HTTPS'}) eq "ON" ? "" :
+ $ENV{'SERVER_PORT'} == 80 && uc($ENV{'HTTPS'}) ne "ON" ? "" :
":$ENV{'SERVER_PORT'}";
-$prot = uc($ENV{'HTTPS'}) eq "ON" ? "https" : "http";
-local $wp = $gconfig{'webprefixnoredir'} ? undef : $gconfig{'webprefix'};
+my $prot = uc($ENV{'HTTPS'}) eq "ON" ? "https" : "http";
+my $wp = $gconfig{'webprefixnoredir'} ? undef : $gconfig{'webprefix'};
+my $url;
if ($_[0] =~ /^(http|https|ftp|gopher):/) {
# Absolute URL (like http://...)
$url = $_[0];
=cut
sub kill_byname
{
-local(@pids);
-@pids = &find_byname($_[0]);
+my @pids = &find_byname($_[0]);
return scalar(@pids) if (&is_readonly_mode());
&webmin_debug_log('KILL', "signal=$_[1] name=$_[0]")
if ($gconfig{'debug_what_procs'});
=cut
sub kill_byname_logged
{
-local(@pids);
-@pids = &find_byname($_[0]);
+my @pids = &find_byname($_[0]);
return scalar(@pids) if (&is_readonly_mode());
if (@pids) { &kill_logged($_[1], @pids); return scalar(@pids); }
else { return 0; }
if ($gconfig{'os_type'} =~ /-linux$/ && -r "/proc/$$/cmdline") {
# Linux with /proc filesystem .. use cmdline files, as this is
# faster than forking
- local @pids;
+ my @pids;
opendir(PROCDIR, "/proc");
foreach my $f (readdir(PROCDIR)) {
if ($f eq int($f) && $f != $$) {
# Call the proc module
&foreign_require("proc", "proc-lib.pl");
if (defined(&proc::list_processes)) {
- local @procs = &proc::list_processes();
- local @pids;
+ my @procs = &proc::list_processes();
+ my @pids;
foreach my $p (@procs) {
if ($p->{'args'} =~ /$_[0]/) {
push(@pids, $p->{'pid'});
}
# Fall back to running a command
-local($cmd, @pids);
+my ($cmd, @pids);
$cmd = $gconfig{'find_pid_command'};
$cmd =~ s/NAME/"$_[0]"/g;
$cmd = &translate_command($cmd);
=cut
sub wait_for
{
-local ($c, $i, $sw, $rv, $ha); undef($wait_for_input);
+my ($c, $i, $sw, $rv, $ha);
+undef($wait_for_input);
if ($wait_for_debug) {
print STDERR "wait_for(",join(",", @_),")\n";
}
$ha = $_[0];
$codes =
-"local \$hit;\n".
+"my \$hit;\n".
"while(1) {\n".
" if ((\$c = getc(\$ha)) eq \"\") { return -1; }\n".
" \$wait_for_input .= \$c;\n";
=cut
sub fast_wait_for
{
-local($inp, $maxlen, $ha, $i, $c, $inpl);
+my ($inp, $maxlen, $ha, $i, $c, $inpl);
for($i=1; $i<@_; $i++) {
$maxlen = length($_[$i]) > $maxlen ? length($_[$i]) : $maxlen;
}
=cut
sub has_command
{
-local($d);
if (!$_[0]) { return undef; }
if (exists($main::has_command_cache{$_[0]})) {
return $main::has_command_cache{$_[0]};
}
-local $rv = undef;
-local $slash = $gconfig{'os_type'} eq 'windows' ? '\\' : '/';
+my $rv = undef;
+my $slash = $gconfig{'os_type'} eq 'windows' ? '\\' : '/';
if ($_[0] =~ /^\// || $_[0] =~ /^[a-z]:[\\\/]/i) {
# Absolute path given - just use it
local $t = &translate_filename($_[0]);
else {
# Check each directory in the path
local %donedir;
- foreach $d (split($path_separator, $ENV{'PATH'})) {
+ foreach my $d (split($path_separator, $ENV{'PATH'})) {
next if ($donedir{$d}++);
$d =~ s/$slash$// if ($d ne $slash);
local $t = &translate_filename("$d/$_[0]");
=cut
sub make_date
{
-local ($secs, $only, $fmt) = @_;
-local @tm = localtime($secs);
-local $date;
+my ($secs, $only, $fmt) = @_;
+my @tm = localtime($secs);
+my $date;
if (!$fmt) {
$fmt = $gconfig{'dateformat'} || 'dd/mon/yyyy';
}
{
return &theme_file_chooser_button(@_)
if (defined(&theme_file_chooser_button));
-local $form = defined($_[2]) ? $_[2] : 0;
-local $chroot = defined($_[3]) ? $_[3] : "/";
-local $add = int($_[4]);
-local ($w, $h) = (400, 300);
+my $form = defined($_[2]) ? $_[2] : 0;
+my $chroot = defined($_[3]) ? $_[3] : "/";
+my $add = int($_[4]);
+my ($w, $h) = (400, 300);
if ($gconfig{'db_sizefile'}) {
($w, $h) = split(/x/, $gconfig{'db_sizefile'});
}
sub popup_window_button
{
return &theme_popup_window_button(@_) if (defined(&theme_popup_window_button));
-local ($url, $w, $h, $scroll, $fields) = @_;
-local $scrollyn = $scroll ? "yes" : "no";
-local $rv;
-$rv .= "<input type=button onClick='";
+my ($url, $w, $h, $scroll, $fields) = @_;
+my $scrollyn = $scroll ? "yes" : "no";
+my $rv = "<input type=button onClick='";
foreach my $m (@$fields) {
$rv .= "$m->[0] = form.$m->[1]; ";
}
-local $sep = $url =~ /\?/ ? "&" : "?";
+my $sep = $url =~ /\?/ ? "&" : "?";
$rv .= "chooser = window.open(\"$url\"";
foreach my $m (@$fields) {
if ($m->[2]) {
=cut
sub read_acl
{
-local($user, $_, @mods);
if (!defined(%main::acl_hash_cache)) {
local $_;
open(ACL, &acl_filename());
while(<ACL>) {
if (/^([^:]+):\s*(.*)/) {
- local(@mods);
- $user = $1;
- @mods = split(/\s+/, $2);
- foreach $m (@mods) {
+ my $user = $1;
+ my @mods = split(/\s+/, $2);
+ foreach my $m (@mods) {
$main::acl_hash_cache{$user,$m}++;
}
$main::acl_array_cache{$user} = \@mods;
=cut
sub restart_miniserv
{
-local ($nowait) = @_;
+my ($nowait) = @_;
return undef if (&is_readonly_mode());
-local %miniserv;
+my %miniserv;
&get_miniserv_config(\%miniserv) || return;
-local $i;
+my $i;
if ($gconfig{'os_type'} ne 'windows') {
# On Unix systems, we can restart with a signal
- local($pid, $addr, $i);
+ my ($pid, $addr, $i);
$miniserv{'inetd'} && return;
- local @oldst = stat($miniserv{'pidfile'});
+ my @oldst = stat($miniserv{'pidfile'});
open(PID, $miniserv{'pidfile'}) || &error("Failed to open PID file");
chop($pid = <PID>);
close(PID);
# Wait till new PID is written, indicating a restart
for($i=0; $i<60; $i++) {
sleep(1);
- local @newst = stat($miniserv{'pidfile'});
+ my @newst = stat($miniserv{'pidfile'});
last if ($newst[9] != $oldst[9]);
}
$i < 60 || &error("Webmin server did not write new PID file");
if (!$nowait) {
# wait for miniserv to come back up
$addr = inet_aton($miniserv{'bind'} ? $miniserv{'bind'} : "127.0.0.1");
- local $ok = 0;
+ my $ok = 0;
for($i=0; $i<20; $i++) {
sleep(1);
socket(STEST, PF_INET, SOCK_STREAM, getprotobyname("tcp"));
- local $rv = connect(STEST,
- pack_sockaddr_in($miniserv{'port'}, $addr));
+ my $rv = connect(STEST,
+ pack_sockaddr_in($miniserv{'port'}, $addr));
close(STEST);
last if ($rv && ++$ok >= 2);
}
sub reload_miniserv
{
return undef if (&is_readonly_mode());
-local %miniserv;
+my %miniserv;
&get_miniserv_config(\%miniserv) || return;
if ($gconfig{'os_type'} ne 'windows') {
# Send a USR1 signal to re-read the config
- local($pid, $addr, $i);
+ my ($pid, $addr, $i);
$miniserv{'inetd'} && return;
open(PID, $miniserv{'pidfile'}) || &error("Failed to open PID file");
chop($pid = <PID>);
=cut
sub check_os_support
{
-local $oss = $_[0]->{'os_support'};
+my $oss = $_[0]->{'os_support'};
if ($_[3] && $oss && $_[0]->{'api_os_support'}) {
# May provide usable API
$oss .= " ".$_[0]->{'api_os_support'};
return 0;
}
return 1 if (!$oss || $oss eq '*');
-local $osver = $_[2] || $gconfig{'os_version'};
-local $ostype = $_[1] || $gconfig{'os_type'};
-local $anyneg = 0;
+my $osver = $_[2] || $gconfig{'os_version'};
+my $ostype = $_[1] || $gconfig{'os_type'};
+my $anyneg = 0;
while(1) {
- local ($os, $ver, $codes);
- local ($neg) = ($oss =~ s/^!//); # starts with !
+ my ($os, $ver, $codes);
+ my ($neg) = ($oss =~ s/^!//); # starts with !
$anyneg++ if ($neg);
if ($oss =~ /^([^\/\s]+)\/([^\{\s]+)\{([^\}]*)\}\s*(.*)$/) {
# OS/version{code}
if (defined(&theme_hlink)) {
return &theme_hlink(@_);
}
-local $mod = $_[2] ? $_[2] : $module_name;
+local $mod = $_[2] ? $_[2] : &get_module_name();
local $width = $_[3] || $tconfig{'help_width'} || $gconfig{'help_width'} || 600;
local $height = $_[4] || $tconfig{'help_height'} || $gconfig{'help_height'} || 400;
return "<a onClick='window.open(\"$gconfig{'webprefix'}/help.cgi/$mod/$_[1]\", \"help\", \"toolbar=no,menubar=no,scrollbars=yes,width=$width,height=$height,resizable=yes\"); return false' href=\"$gconfig{'webprefix'}/help.cgi/$mod/$_[1]\">$_[0]</a>";
=cut
sub foreign_check
{
-local ($mod, $api) = @_;
-local %minfo;
-local $mdir = &module_root_directory($mod);
+my ($mod, $api) = @_;
+my %minfo;
+my $mdir = &module_root_directory($mod);
&read_file_cached("$mdir/module.info", \%minfo) || return 0;
return &check_os_support(\%minfo, undef, undef, $api);
}
=cut
sub foreign_exists
{
-local $mdir = &module_root_directory($_[0]);
+my $mdir = &module_root_directory($_[0]);
return -r "$mdir/module.info";
}
{
return 0 if (!&foreign_check($_[0]) &&
!$gconfig{'available_even_if_no_support'});
-local %module_info = &get_module_info($_[0]);
+my %foreign_module_info = &get_module_info($_[0]);
# Check list of allowed modules
-local %acl;
+my %acl;
&read_acl(\%acl, undef);
return 0 if (!$acl{$base_remote_user,$_[0]} &&
!$acl{$base_remote_user,'*'});
# Check for usermod restrictions
-local @usermods = &list_usermods();
-return 0 if (!&available_usermods( [ \%module_info ], \@usermods));
+my @usermods = &list_usermods();
+return 0 if (!&available_usermods( [ \%foreign_module_info ], \@usermods));
if (&get_product_name() eq "webmin") {
# Check if the user has any RBAC privileges in this module
&use_rbac_module_acl(undef, $_[0])) {
# RBAC is enabled for this user and module - check if he
# has any rights
- local $rbacs = &get_rbac_module_acl(
- $remote_user, $_[0]);
+ my $rbacs = &get_rbac_module_acl($remote_user, $_[0]);
return 0 if (!$rbacs);
}
elsif ($gconfig{'rbacdeny_'.$u}) {
# Check readonly support
if (&is_readonly_mode()) {
- return 0 if (!$module_info{'readonly'});
+ my %this_module_info = &get_module_info(&get_module_name());
+ return 0 if (!$this_module_info{'readonly'});
}
# Check if theme vetos
=cut
sub foreign_require
{
-local $pkg = $_[2] || $_[0] || "global";
+my $pkg = $_[2] || $_[0] || "global";
$pkg =~ s/[^A-Za-z0-9]/_/g;
return 1 if ($main::done_foreign_require{$pkg,$_[1]}++);
-local @OLDINC = @INC;
-local $mdir = &module_root_directory($_[0]);
+my @OLDINC = @INC;
+my $mdir = &module_root_directory($_[0]);
@INC = &unique($mdir, @INC);
-d $mdir || &error("module $_[0] does not exist");
-if (!$module_name && $_[0]) {
+if (!&get_module_name() && $_[0]) {
chdir($mdir);
}
-local $old_fmn = $ENV{'FOREIGN_MODULE_NAME'};
-local $old_frd = $ENV{'FOREIGN_ROOT_DIRECTORY'};
+my $old_fmn = $ENV{'FOREIGN_MODULE_NAME'};
+my $old_frd = $ENV{'FOREIGN_ROOT_DIRECTORY'};
eval <<EOF;
package $pkg;
\$ENV{'FOREIGN_MODULE_NAME'} = '$_[0]';
=cut
sub foreign_call
{
-local $pkg = $_[0] ? $_[0] : "global";
+my $pkg = $_[0] || "global";
$pkg =~ s/[^A-Za-z0-9]/_/g;
-local @args = @_[2 .. @_-1];
+my @args = @_[2 .. @_-1];
$main::foreign_args = \@args;
-local @rv = eval <<EOF;
+my @rv = eval <<EOF;
package $pkg;
&$_[1](\@{\$main::foreign_args});
EOF
=cut
sub foreign_config
{
-local ($mod, $uc) = @_;
-local %fconfig;
+my ($mod, $uc) = @_;
+my %fconfig;
if ($uc) {
&read_file_cached("$root_directory/$mod/defaultuconfig", \%fconfig);
&read_file_cached("$config_directory/$mod/uconfig", \%fconfig);
=cut
sub foreign_installed
{
-local ($mod, $configured) = @_;
+my ($mod, $configured) = @_;
if (defined($main::foreign_installed_cache{$mod,$configured})) {
# Already cached..
return $main::foreign_installed_cache{$mod,$configured};
}
else {
- local $rv;
+ my $rv;
if (!&foreign_check($mod)) {
# Module is missing
$rv = 0;
}
else {
- local $mdir = &module_root_directory($mod);
+ my $mdir = &module_root_directory($mod);
if (!-r "$mdir/install_check.pl") {
# Not known, assume OK
$rv = $configured ? 2 : 1;
=cut
sub foreign_defined
{
-local $pkg = $_[0];
+my ($pkg) = @_;
$pkg =~ s/[^A-Za-z0-9]/_/g;
-local $func = "${pkg}::$_[1]";
+my $func = "${pkg}::$_[1]";
return defined(&$func);
}
=cut
sub get_system_hostname
{
-local $m = int($_[0]);
+my $m = int($_[0]);
if (!$main::get_system_hostname[$m]) {
if ($gconfig{'os_type'} ne 'windows') {
# Try some common Linux hostname files first
if ($gconfig{'os_type'} eq 'redhat-linux') {
- local %nc;
+ my %nc;
&read_env_file("/etc/sysconfig/network", \%nc);
if ($nc{'HOSTNAME'}) {
$main::get_system_hostname[$m] =$nc{'HOSTNAME'};
}
}
elsif ($gconfig{'os_type'} eq 'debian-linux') {
- local $hn = &read_file_contents("/etc/hostname");
+ my $hn = &read_file_contents("/etc/hostname");
if ($hn) {
$hn =~ s/\r|\n//g;
$main::get_system_hostname[$m] = $hn;
}
}
elsif ($gconfig{'os_type'} eq 'open-linux') {
- local $hn = &read_file_contents("/etc/HOSTNAME");
+ my $hn = &read_file_contents("/etc/HOSTNAME");
if ($hn) {
$hn =~ s/\r|\n//g;
$main::get_system_hostname[$m] = $hn;
}
}
elsif ($gconfig{'os_type'} eq 'solaris') {
- local $hn = &read_file_contents("/etc/nodename");
+ my $hn = &read_file_contents("/etc/nodename");
if ($hn) {
$hn =~ s/\r|\n//g;
$main::get_system_hostname[$m] = $hn;
$gconfig{'os_type'} =~ /linux$/ &&
!$gconfig{'no_hostname_f'} && !$_[0]) {
# Try with -f flag to get fully qualified name
- local $flag;
- local $ex = &execute_command("hostname -f", undef, \$flag,
- undef, 0, 1);
+ my $flag;
+ my $ex = &execute_command("hostname -f", undef, \$flag,
+ undef, 0, 1);
chop($flag);
if ($ex || $flag eq "") {
- # -f not supported! We have probably set the hostname
- # to just '-f'. Fix the problem (if we are root)
+ # -f not supported! We have probably set the
+ # hostname to just '-f'. Fix the problem
+ # (if we are root)
if ($< == 0) {
&execute_command("hostname ".
quotemeta($main::get_system_hostname[$m]),
return $ENV{'COMPUTERNAME'} if ($ENV{'COMPUTERNAME'});
# Fall back to net name command
- local $out = `net name 2>&1`;
+ my $out = `net name 2>&1`;
if ($out =~ /\-+\r?\n(\S+)/) {
$main::get_system_hostname[$m] = $1;
}
=cut
sub get_module_acl
{
-local %rv;
-local $u = defined($_[0]) ? $_[0] : $base_remote_user;
-local $m = defined($_[1]) ? $_[1] : $module_name;
-local $mdir = &module_root_directory($m);
+my $u = defined($_[0]) ? $_[0] : $base_remote_user;
+my $m = defined($_[1]) ? $_[1] : &get_module_name();
+my $mdir = &module_root_directory($m);
+my %rv;
if (!$_[3]) {
# Read default ACL first, to be overridden by per-user settings
&read_file_cached("$mdir/defaultacl", \%rv);
# If this isn't a master admin user, apply the negative permissions
# so that he doesn't un-expectedly gain access to new features
- local %gacccess;
+ my %gacccess;
&read_file_cached("$config_directory/$u.acl", \%gaccess);
if ($gaccess{'negative'}) {
&read_file_cached("$mdir/negativeacl", \%rv);
}
}
-local %usersacl;
+my %usersacl;
if (!$_[2] && &supports_rbac($m) && &use_rbac_module_acl($u, $m)) {
# RBAC overrides exist for this user in this module
- local $rbac = &get_rbac_module_acl(
+ my $rbac = &get_rbac_module_acl(
defined($_[0]) ? $_[0] : $remote_user, $m);
- local $r;
- foreach $r (keys %$rbac) {
+ foreach my $r (keys %$rbac) {
$rv{$r} = $rbac->{$r};
}
}
elsif ($gconfig{"risk_$u"} && $m) {
# ACL is defined by user's risk level
- local $rf = $gconfig{"risk_$u"}.'.risk';
+ my $rf = $gconfig{"risk_$u"}.'.risk';
&read_file_cached("$mdir/$rf", \%rv);
- local $sf = $gconfig{"skill_$u"}.'.skill';
+ my $sf = $gconfig{"skill_$u"}.'.skill';
&read_file_cached("$mdir/$sf", \%rv);
}
elsif ($u ne '') {
=cut
sub get_group_module_acl
{
-local %rv;
-local $g = $_[0];
-local $m = defined($_[1]) ? $_[1] : $module_name;
-local $mdir = &module_root_directory($m);
+my $g = $_[0];
+my $m = defined($_[1]) ? $_[1] : &get_module_name();
+my $mdir = &module_root_directory($m);
+my %rv;
&read_file_cached("$mdir/defaultacl", \%rv);
&read_file_cached("$config_directory/$m/$g.gacl", \%rv);
if (defined(&theme_get_module_acl)) {
=cut
sub save_module_acl
{
-local $u = defined($_[1]) ? $_[1] : $base_remote_user;
-local $m = defined($_[2]) ? $_[2] : $module_name;
+my $u = defined($_[1]) ? $_[1] : $base_remote_user;
+my $m = defined($_[2]) ? $_[2] : &get_module_name();
if (&foreign_check("acl")) {
# Check if this user is a member of a group, and if he gets the
# module from a group. If so, update its ACL as well
&foreign_require("acl", "acl-lib.pl");
- local ($g, $group);
- foreach $g (&acl::list_groups()) {
+ my $group;
+ foreach my $g (&acl::list_groups()) {
if (&indexof($u, @{$g->{'members'}}) >= 0 &&
&indexof($m, @{$g->{'modules'}}) >= 0) {
$group = $g;
=cut
sub save_group_module_acl
{
-local $g = $_[1];
-local $m = defined($_[2]) ? $_[2] : $module_name;
+my $g = $_[1];
+my $m = defined($_[2]) ? $_[2] : &get_module_name();
if (&foreign_check("acl")) {
# Check if this group is a member of a group, and if it gets the
# module from a group. If so, update the parent ACL as well
&foreign_require("acl", "acl-lib.pl");
- local ($pg, $group);
- foreach $pg (&acl::list_groups()) {
+ my $group;
+ foreach my $pg (&acl::list_groups()) {
if (&indexof('@'.$g, @{$pg->{'members'}}) >= 0 &&
&indexof($m, @{$pg->{'modules'}}) >= 0) {
$group = $g;
}
# Find all root directories
-local %miniserv;
+my %miniserv;
if (&get_miniserv_config(\%miniserv)) {
@root_directories = ( $miniserv{'root'} );
for($i=0; defined($miniserv{"extraroot_$i"}); $i++) {
@root_directories = ( $root_directory ) if (!@root_directories);
}
elsif ($ENV{'SCRIPT_NAME'}) {
- local $sn = $ENV{'SCRIPT_NAME'};
+ my $sn = $ENV{'SCRIPT_NAME'};
$sn =~ s/^$gconfig{'webprefix'}//
if (!$gconfig{'webprefixnoredir'});
if ($sn =~ /^\/([^\/]+)\//) {
else {
# Get root directory from miniserv.conf, and deduce module name from $0
$root_directory = $root_directories[0];
- local $r;
- local $rok = 0;
- foreach $r (@root_directories) {
+ my $rok = 0;
+ foreach my $r (@root_directories) {
if ($0 =~ /^$r\/([^\/]+)\/[^\/]+$/i) {
# Under a module directory
$module_name = $1;
# Set IO scheduling class and priority
if ($gconfig{'sclass'} ne '' || $gconfig{'sprio'} ne '') {
- local $cmd = "ionice";
+ my $cmd = "ionice";
$cmd .= " -c ".quotemeta($gconfig{'sclass'})
if ($gconfig{'sclass'} ne '');
$cmd .= " -n ".quotemeta($gconfig{'sprio'})
$main::nice_already++;
# Get the username
-local $u = $ENV{'BASE_REMOTE_USER'} ? $ENV{'BASE_REMOTE_USER'}
- : $ENV{'REMOTE_USER'};
+my $u = $ENV{'BASE_REMOTE_USER'} || $ENV{'REMOTE_USER'};
$base_remote_user = $u;
$remote_user = $ENV{'REMOTE_USER'};
if ($module_name) {
# Find and load the configuration file for this module
- local (@ruinfo, $rgroup);
+ my (@ruinfo, $rgroup);
$module_config_directory = "$config_directory/$module_name";
if (&get_product_name() eq "usermin" &&
-r "$module_config_directory/config.$remote_user") {
# If debugging is enabled, open the debug log
if ($gconfig{'debug_enabled'} && !$main::opened_debug_log++) {
- local $dlog = $gconfig{'debug_file'} || $main::default_debug_log_file;
+ my $dlog = $gconfig{'debug_file'} || $main::default_debug_log_file;
if ($gconfig{'debug_size'}) {
- local @st = stat($dlog);
+ my @st = stat($dlog);
if ($st[7] > $gconfig{'debug_size'}) {
rename($dlog, $dlog.".0");
}
$main::opened_debug_log = 1;
if ($gconfig{'debug_what_start'}) {
- local $script_name = $0 =~ /([^\/]+)$/ ? $1 : '-';
+ my $script_name = $0 =~ /([^\/]+)$/ ? $1 : '-';
$main::debug_log_start_time = time();
&webmin_debug_log("START", "script=$script_name");
$main::debug_log_start_module = $module_name;
$main::initial_module_name ||= $module_name;
# Set some useful variables
-local $current_themes;
+my $current_themes;
$current_themes = $ENV{'MOBILE_DEVICE'} && defined($gconfig{'mobile_theme'}) ?
$gconfig{'mobile_theme'} :
defined($gconfig{'theme_'.$remote_user}) ?
$theme_root_directory = $theme_root_directories[0];
@theme_configs = ( );
foreach my $troot (@theme_root_directories) {
- local %onetconfig;
+ my %onetconfig;
&read_file_cached("$troot/config", \%onetconfig);
&read_file_cached("$troot/config", \%tconfig);
push(@theme_configs, \%onetconfig);
: "$var_directory/webmin.log";
# Load language strings into %text
-local @langs = &list_languages();
-local ($l, $a, $accepted_lang);
+my @langs = &list_languages();
+my $accepted_lang;
if ($gconfig{'acceptlang'}) {
- foreach $a (split(/,/, $ENV{'HTTP_ACCEPT_LANGUAGE'})) {
- local ($al) = grep { $_->{'lang'} eq $a } @langs;
+ foreach my $a (split(/,/, $ENV{'HTTP_ACCEPT_LANGUAGE'})) {
+ my ($al) = grep { $_->{'lang'} eq $a } @langs;
if ($al) {
$accepted_lang = $al->{'lang'};
last;
$gconfig{"lang_$remote_user"} ? $gconfig{"lang_$remote_user"} :
$gconfig{"lang_$base_remote_user"} ? $gconfig{"lang_$base_remote_user"} :
$gconfig{"lang"} ? $gconfig{"lang"} : $default_lang;
-foreach $l (@langs) {
+foreach my $l (@langs) {
$current_lang_info = $l if ($l->{'lang'} eq $current_lang);
}
@lang_order_list = &unique($default_lang,
# Get the %module_info for this module
if ($module_name) {
- local ($mi) = grep { $_->{'dir'} eq $module_name }
+ my ($mi) = grep { $_->{'dir'} eq $module_name }
&get_all_module_infos(2);
%module_info = %$mi;
$module_root_directory = &module_root_directory($module_name);
}
# Check the Referer: header for nasty redirects
-local @referers = split(/\s+/, $gconfig{'referers'});
-local $referer_site;
+my @referers = split(/\s+/, $gconfig{'referers'});
+my $referer_site;
if ($ENV{'HTTP_REFERER'} =~/^(http|https|ftp):\/\/([^:\/]+:[^@\/]+@)?([^\/:@]+)/) {
$referer_site = $3;
}
-local $http_host = $ENV{'HTTP_HOST'};
+my $http_host = $ENV{'HTTP_HOST'};
$http_host =~ s/:\d+$//;
if ($0 &&
($ENV{'SCRIPT_NAME'} !~ /^\/(index.cgi)?$/ || $unsafe_index_cgi) &&
&header($text{'referer_title'}, "", undef, 0, 1, 1);
$prot = lc($ENV{'HTTPS'}) eq 'on' ? "https" : "http";
- local $url = "<tt>".&html_escape("$prot://$ENV{'HTTP_HOST'}$ENV{'REQUEST_URI'}")."</tt>";
+ my $url = "<tt>".&html_escape("$prot://$ENV{'HTTP_HOST'}$ENV{'REQUEST_URI'}")."</tt>";
if ($referer_site) {
# From a known host
print &text('referer_warn',
}
# Record that we have done the calling library in this package
-local ($pkg, $lib) = caller();
+my ($callpkg, $lib) = caller();
$lib =~ s/^.*\///;
-$main::done_foreign_require{$pkg,$lib} = 1;
+$main::done_foreign_require{$callpkg,$lib} = 1;
# If a licence checking is enabled, do it now
if ($gconfig{'licence_module'} && !$main::done_licence_module_check &&
&foreign_check($gconfig{'licence_module'}) &&
-r "$root_directory/$gconfig{'licence_module'}/licence_check.pl") {
- local $oldpwd = &get_current_dir();
+ my $oldpwd = &get_current_dir();
$main::done_licence_module_check++;
$main::licence_module = $gconfig{'licence_module'};
&foreign_require($main::licence_module, "licence_check.pl");
chdir($oldpwd);
}
+# Export global variables to caller
+if ($main::export_to_caller) {
+ foreach my $v ('$config_file', '%gconfig', '$null_file',
+ '$path_separator', '@root_directories',
+ '$root_directory', '$module_name',
+ '$base_remote_user', '$remote_user',
+ '$module_config_directory', '$module_config_file',
+ '%config', '@current_themes', '$current_theme',
+ '@theme_root_directories', '$theme_root_directory',
+ '@theme_configs', '$tb', '$cb', '$scriptname',
+ '$webmin_logfile', '$current_lang',
+ '$current_lang_info', '@lang_order_list', '%text',
+ '%module_info', '$module_root_directory') {
+ my ($vt, $vn) = split('', $v, 2);
+ eval "${vt}${callpkg}::${vn} = ${vt}${vn}";
+ }
+ }
+
return 1;
}
-$default_lang = "en";
-
=head2 load_language([module], [directory])
Returns a hashtable mapping text codes to strings in the appropriate language,
=cut
sub load_language
{
-local %text;
-local $root = $root_directory;
-local $ol = $gconfig{'overlang'};
-local $o;
-local ($dir) = ($_[1] || "lang");
+my %text;
+my $root = $root_directory;
+my $ol = $gconfig{'overlang'};
+my ($dir) = ($_[1] || "lang");
# Read global lang files
-foreach $o (@lang_order_list) {
- local $ok = &read_file_cached("$root/$dir/$o", \%text);
+foreach my $o (@lang_order_list) {
+ my $ok = &read_file_cached("$root/$dir/$o", \%text);
return () if (!$ok && $o eq $default_lang);
}
if ($ol) {
- foreach $o (@lang_order_list) {
+ foreach my $o (@lang_order_list) {
&read_file_cached("$root/$ol/$o", \%text);
}
}
if ($_[0]) {
# Read module's lang files
- local $mdir = &module_root_directory($_[0]);
- foreach $o (@lang_order_list) {
+ my $mdir = &module_root_directory($_[0]);
+ foreach my $o (@lang_order_list) {
&read_file_cached("$mdir/$dir/$o", \%text);
}
if ($ol) {
{
if (substr($_[0], 0, 8) eq "include:") {
local $_;
- local $rv;
+ my $rv;
open(INCLUDE, substr($_[0], 8));
while(<INCLUDE>) {
$rv .= $_;
return $rv;
}
else {
- local $t = $_[1]->{$_[0]};
+ my $t = $_[1]->{$_[0]};
return defined($t) ? $t : '$'.$_[0];
}
}
=cut
sub text
{
-local $rv = $text{$_[0]};
-local $i;
-for($i=1; $i<@_; $i++) {
+my $t = &get_module_variable('%text', 1);
+my $rv = $t->{$_[0]};
+for(my $i=1; $i<@_; $i++) {
$rv =~ s/\$$i/$_[$i]/g;
}
return $rv;
=cut
sub encode_base64
{
- local $res;
- pos($_[0]) = 0; # ensure start at the beginning
- while ($_[0] =~ /(.{1,57})/gs) {
- $res .= substr(pack('u57', $1), 1)."\n";
- chop($res);
- }
- $res =~ tr|\` -_|AA-Za-z0-9+/|;
- local $padding = (3 - length($_[0]) % 3) % 3;
- $res =~ s/.{$padding}$/'=' x $padding/e if ($padding);
- return $res;
+my $res;
+pos($_[0]) = 0; # ensure start at the beginning
+while ($_[0] =~ /(.{1,57})/gs) {
+ $res .= substr(pack('u57', $1), 1)."\n";
+ chop($res);
+ }
+$res =~ tr|\` -_|AA-Za-z0-9+/|;
+my $padding = (3 - length($_[0]) % 3) % 3;
+$res =~ s/.{$padding}$/'=' x $padding/e if ($padding);
+return $res;
}
=head2 decode_base64(string)
=cut
sub decode_base64
{
- local $str = $_[0];
- local $res;
-
- $str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars
- if (length($str) % 4) {
+my ($str) = @_;
+my $res;
+$str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars
+if (length($str) % 4) {
return undef;
- }
- $str =~ s/=+$//; # remove padding
- $str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format
- while ($str =~ /(.{1,60})/gs) {
+}
+$str =~ s/=+$//; # remove padding
+$str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format
+while ($str =~ /(.{1,60})/gs) {
my $len = chr(32 + length($1)*3/4); # compute length byte
$res .= unpack("u", $len . $1 ); # uudecode
- }
- return $res;
+ }
+return $res;
}
=head2 get_module_info(module, [noclone], [forcache])
sub get_module_info
{
return () if ($_[0] =~ /^\./);
-local (%rv, $clone, $o);
-local $mdir = &module_root_directory($_[0]);
+my (%rv, $clone, $o);
+my $mdir = &module_root_directory($_[0]);
&read_file_cached("$mdir/module.info", \%rv) || return ();
$clone = -l $mdir;
foreach $o (@lang_order_list) {
&read_file("$config_directory/$_[0]/clone", \%rv);
}
$rv{'dir'} = $_[0];
-local %module_categories;
+my %module_categories;
&read_file_cached("$config_directory/webmin.cats", \%module_categories);
-local $pn = &get_product_name();
+my $pn = &get_product_name();
if (defined($rv{'category_'.$pn})) {
# Can override category for webmin/usermin
$rv{'category'} = $rv{'category_'.$pn};
# Apply description overrides
$rv{'realdesc'} = $rv{'desc'};
-local %descs;
+my %descs;
&read_file_cached("$config_directory/webmin.descs", \%descs);
if ($descs{$_[0]." ".$current_lang}) {
$rv{'desc'} = $descs{$_[0]." ".$current_lang};
if (!$_[2]) {
# Apply per-user description overridde
- local %gaccess = &get_module_acl(undef, "");
+ my %gaccess = &get_module_acl(undef, "");
if ($gaccess{'desc_'.$_[0]}) {
$rv{'desc'} = $gaccess{'desc_'.$_[0]};
}
=cut
sub get_all_module_infos
{
-local (%cache, $k, $m, $r, @rv);
+my (%cache, @rv);
# Is the cache out of date? (ie. have any of the root's changed?)
-local $cache_file = "$config_directory/module.infos.cache";
-local $changed = 0;
+my $cache_file = "$config_directory/module.infos.cache";
+my $changed = 0;
if (&read_file_cached($cache_file, \%cache)) {
- foreach $r (@root_directories) {
- local @st = stat($r);
+ foreach my $r (@root_directories) {
+ my @st = stat($r);
if ($st[9] != $cache{'mtime_'.$r}) {
$changed = 2;
last;
if ($_[0] != 1 && !$changed && $cache{'lang'} eq $current_lang) {
# Can use existing module.info cache
- local %mods;
- foreach $k (keys %cache) {
+ my %mods;
+ foreach my $k (keys %cache) {
if ($k =~ /^(\S+) (\S+)$/) {
$mods{$1}->{$2} = $cache{$k};
}
else {
# Need to rebuild cache
%cache = ( );
- foreach $r (@root_directories) {
+ foreach my $r (@root_directories) {
opendir(DIR, $r);
- foreach $m (readdir(DIR)) {
+ foreach my $m (readdir(DIR)) {
next if ($m =~ /^(config-|\.)/ || $m =~ /\.(cgi|pl)$/);
- local %minfo = &get_module_info($m, 0, 1);
+ my %minfo = &get_module_info($m, 0, 1);
next if (!%minfo || !$minfo{'dir'});
push(@rv, \%minfo);
foreach $k (keys %minfo) {
}
}
closedir(DIR);
- local @st = stat($r);
+ my @st = stat($r);
$cache{'mtime_'.$r} = $st[9];
}
$cache{'lang'} = $current_lang;
}
# Override descriptions for modules for current user
-local %gaccess = &get_module_acl(undef, "");
-foreach $m (@rv) {
+my %gaccess = &get_module_acl(undef, "");
+foreach my $m (@rv) {
if ($gaccess{"desc_".$m->{'dir'}}) {
$m->{'desc'} = $gaccess{"desc_".$m->{'dir'}};
}
}
# Apply installed flags
-local %installed;
+my %installed;
&read_file_cached("$config_directory/installed.cache", \%installed);
-foreach $m (@rv) {
+foreach my $m (@rv) {
$m->{'installed'} = $installed{$m->{'dir'}};
}
sub get_theme_info
{
return () if ($_[0] =~ /^\./);
-local (%rv, $o);
-local $tdir = &module_root_directory($_[0]);
+my %rv;
+my $tdir = &module_root_directory($_[0]);
&read_file("$tdir/theme.info", \%rv) || return ();
-foreach $o (@lang_order_list) {
+foreach my $o (@lang_order_list) {
$rv{"desc"} = $rv{"desc_$o"} if ($rv{"desc_$o"});
}
$rv{"dir"} = $_[0];
sub list_languages
{
if (!@main::list_languages_cache) {
- local ($o, $_);
+ my $o;
+ local $_;
open(LANG, "$root_directory/lang_list.txt");
while(<LANG>) {
if (/^(\S+)\s+(.*)/) {
- local $l = { 'desc' => $2 };
+ my $l = { 'desc' => $2 };
foreach $o (split(/,/, $1)) {
if ($o =~ /^([^=]+)=(.*)$/) {
$l->{$1} = $2;
=cut
sub write_env_file
{
-local $k;
-local $exp = $_[2] ? "export " : "";
+my $exp = $_[2] ? "export " : "";
&open_tempfile(FILE, ">$_[0]");
-foreach $k (keys %{$_[1]}) {
- local $v = $_[1]->{$k};
+foreach my $k (keys %{$_[1]}) {
+ my $v = $_[1]->{$k};
if ($v =~ /^\S+$/) {
&print_tempfile(FILE, "$exp$k=$v\n");
}
=cut
sub lock_file
{
-local $realfile = &translate_filename($_[0]);
+my $realfile = &translate_filename($_[0]);
return 0 if (!$_[0] || defined($main::locked_file_list{$realfile}));
-local $no_lock = !&can_lock_file($realfile);
-local $lock_tries_count = 0;
+my $no_lock = !&can_lock_file($realfile);
+my $lock_tries_count = 0;
while(1) {
- local $pid;
+ my $pid;
if (!$no_lock && open(LOCKING, "$realfile.lock")) {
$pid = <LOCKING>;
$pid = int($pid);
if (!$no_lock) {
# Create the .lock file
open(LOCKING, ">$realfile.lock") || return 0;
- local $lck = eval "flock(LOCKING, 2+4)";
+ my $lck = eval "flock(LOCKING, 2+4)";
if (!$lck && !$@) {
# Lock of lock file failed! Wait till later
goto tryagain;
if (($gconfig{'logfiles'} || $gconfig{'logfullfiles'}) &&
!$_[1]) {
# Grab a copy of this file for later diffing
- local $lnk;
+ my $lnk;
$main::locked_file_data{$realfile} = undef;
if (-d $realfile) {
$main::locked_file_type{$realfile} = 1;
=cut
sub unlock_file
{
-local $realfile = &translate_filename($_[0]);
+my $realfile = &translate_filename($_[0]);
return if (!$_[0] || !defined($main::locked_file_list{$realfile}));
unlink("$realfile.lock") if (&can_lock_file($realfile));
delete($main::locked_file_list{$realfile});
if (exists($main::locked_file_data{$realfile})) {
# Diff the new file with the old
stat($realfile);
- local $lnk = readlink($realfile);
- local $type = -d _ ? 1 : $lnk ? 2 : 0;
- local $oldtype = $main::locked_file_type{$realfile};
- local $new = !defined($main::locked_file_data{$realfile});
+ my $lnk = readlink($realfile);
+ my $type = -d _ ? 1 : $lnk ? 2 : 0;
+ my $oldtype = $main::locked_file_type{$realfile};
+ my $new = !defined($main::locked_file_data{$realfile});
if ($new && !-e _) {
# file doesn't exist, and never did! do nothing ..
}
}
else {
# is a file, or has changed type?!
- local ($diff, $delete_file);
- local $type = "modify";
+ my ($diff, $delete_file);
+ my $type = "modify";
if (!-r _) {
open(NEWFILE, ">$realfile");
close(NEWFILE);
=cut
sub test_lock
{
-local $realfile = &translate_filename($_[0]);
+my $realfile = &translate_filename($_[0]);
return 0 if (!$_[0]);
return 1 if (defined($main::locked_file_list{$realfile}));
return 0 if (!&can_lock_file($realfile));
-local $pid;
+my $pid;
if (open(LOCKING, "$realfile.lock")) {
$pid = <LOCKING>;
$pid = int($pid);
}
else {
# Check if under any of the directories
- local ($d, $match);
- foreach $d (split(/\t+/, $gconfig{'lockdirs'})) {
+ my $match;
+ foreach my $d (split(/\t+/, $gconfig{'lockdirs'})) {
if (&same_file($d, $_[0]) ||
&is_under_directory($d, $_[0])) {
$match = 1;
sub webmin_log
{
return if (!$gconfig{'log'} || &is_readonly_mode());
-local $m = $_[4] ? $_[4] : $module_name;
+my $m = $_[4] ? $_[4] : &get_module_name();
if ($gconfig{'logclear'}) {
# check if it is time to clear the log
- local @st = stat("$webmin_logfile.time");
- local $write_logtime = 0;
+ my @st = stat("$webmin_logfile.time");
+ my $write_logtime = 0;
if (@st) {
if ($st[9]+$gconfig{'logtime'}*60*60 < time()) {
# clear logfile and all diff files
next if ($file =~ /^\.\.?$/); # skip '.' and '..'
if (-x "$dir/$file") {
# Call a script notifying it of the action
- local %OLDENV = %ENV;
- $ENV{'ACTION_MODULE'} = $module_name;
+ my %OLDENV = %ENV;
+ $ENV{'ACTION_MODULE'} = &get_module_name();
$ENV{'ACTION_ACTION'} = $_[0];
$ENV{'ACTION_TYPE'} = $_[1];
$ENV{'ACTION_OBJECT'} = $_[2];
$ENV{'ACTION_SCRIPT'} = $script_name;
- local $p;
- foreach $p (keys %param) {
+ foreach my $p (keys %param) {
$ENV{'ACTION_PARAM_'.uc($p)} = $param{$p};
}
- system("$dir/$file", @_, "<$null_file", ">$null_file", "2>&1");
+ system("$dir/$file", @_,
+ "<$null_file", ">$null_file", "2>&1");
%ENV = %OLDENV;
}
}
split(/\s+/, $gconfig{'logmodules'})) < 0);
# log the action
-local $now = time();
-local @tm = localtime($now);
-local $script_name = $0 =~ /([^\/]+)$/ ? $1 : '-';
-local $id = sprintf "%d.%d.%d",
- $now, $$, $main::action_id_count;
+my $now = time();
+my @tm = localtime($now);
+my $script_name = $0 =~ /([^\/]+)$/ ? $1 : '-';
+my $id = sprintf "%d.%d.%d", $now, $$, $main::action_id_count;
$main::action_id_count++;
-local $line = sprintf "%s [%2.2d/%s/%4.4d %2.2d:%2.2d:%2.2d] %s %s %s %s %s \"%s\" \"%s\" \"%s\"",
+my $line = sprintf "%s [%2.2d/%s/%4.4d %2.2d:%2.2d:%2.2d] %s %s %s %s %s \"%s\" \"%s\" \"%s\"",
$id, $tm[3], $text{"smonth_".($tm[4]+1)}, $tm[5]+1900,
$tm[2], $tm[1], $tm[0],
$remote_user || '-',
$_[7] || $ENV{'REMOTE_HOST'} || '-',
$m, $_[5] ? "$_[5]:$_[6]" : $script_name,
$_[0], $_[1] ne '' ? $_[1] : '-', $_[2] ne '' ? $_[2] : '-';
-local %param;
-foreach $k (sort { $a cmp $b } keys %{$_[3]}) {
- local $v = $_[3]->{$k};
- local @pv;
+my %param;
+foreach my $k (sort { $a cmp $b } keys %{$_[3]}) {
+ my $v = $_[3]->{$k};
+ my @pv;
if ($v eq '') {
$line .= " $k=''";
@rv = ( "" );
if ($gconfig{'logfiles'}) {
# Find and record the changes made to any locked files, or commands run
- local $i = 0;
+ my $i = 0;
mkdir("$ENV{'WEBMIN_VAR'}/diffs", 0700);
- foreach $d (@main::locked_file_diff) {
+ foreach my $d (@main::locked_file_diff) {
mkdir("$ENV{'WEBMIN_VAR'}/diffs/$id", 0700);
open(DIFFLOG, ">$ENV{'WEBMIN_VAR'}/diffs/$id/$i");
print DIFFLOG "$d->{'type'} $d->{'object'}\n";
}
if ($gconfig{'logfullfiles'}) {
# Save the original contents of any modified files
- local $i = 0;
+ my $i = 0;
mkdir("$ENV{'WEBMIN_VAR'}/files", 0700);
- local $f;
- foreach $f (keys %main::orig_file_data) {
+ foreach my $f (keys %main::orig_file_data) {
mkdir("$ENV{'WEBMIN_VAR'}/files/$id", 0700);
open(ORIGLOG, ">$ENV{'WEBMIN_VAR'}/files/$id/$i");
if (!defined($main::orig_file_type{$f})) {
if (!$@) {
# Syslog module is installed .. try to convert to a
# human-readable form
- local $msg;
+ my $msg;
if (-r "$module_root_directory/log_parser.pl") {
do "$module_root_directory/log_parser.pl";
- local %params;
+ my %params;
foreach my $k (keys %{$_[3]}) {
my $v = $_[3]->{$k};
if (ref($v) eq 'ARRAY') {
$msg =~ s/<[^>]*>//g; # Remove tags
}
elsif ($_[0] eq "_config_") {
- local %wtext = &load_language("webminlog");
+ my %wtext = &load_language("webminlog");
$msg = $wtext{'search_config'};
}
else {
$msg = "$_[0] $_[1] $_[2]";
}
- local %info = $m eq $module_name ? %module_info
- : &get_module_info($m);
+ my %info = &get_module_info($m);
eval { syslog("info", "%s", "[$info{'desc'}] $msg"); };
}
}
=cut
sub webmin_debug_log
{
-local ($type, $msg) = @_;
+my ($type, $msg) = @_;
return 0 if (!$main::opened_debug_log);
return 0 if ($gconfig{'debug_no'.$main::webmin_script_type});
-local $now = time();
-local @tm = localtime($now);
-local $line = sprintf
+my $now = time();
+my @tm = localtime($now);
+my $line = sprintf
"%s [%2.2d/%s/%4.4d %2.2d:%2.2d:%2.2d] %s %s %s %s \"%s\"",
$$, $tm[3], $text{"smonth_".($tm[4]+1)}, $tm[5]+1900,
$tm[2], $tm[1], $tm[0],
$remote_user || "-",
$ENV{'REMOTE_HOST'} || "-",
- $module_name || "-",
+ &get_module_name() || "-",
$type,
$msg;
seek(main::DEBUGLOG, 0, 2);
print STDERR "Vetoing command $_[0]\n";
return 0;
}
-local @realcmd = ( &translate_command($_[0]), @_[1..$#_] );
-local $cmd = join(" ", @realcmd);
-local $and;
+my @realcmd = ( &translate_command($_[0]), @_[1..$#_] );
+my $cmd = join(" ", @realcmd);
+my $and;
if ($cmd =~ s/(\s*&\s*)$//) {
$and = $1;
}
print STDERR "Vetoing command $_[0]\n";
return undef;
}
-local $realcmd = &translate_command($_[0]);
-local $cmd = $realcmd;
-local $and;
+my $realcmd = &translate_command($_[0]);
+my $cmd = $realcmd;
+my $and;
if ($cmd =~ s/(\s*&\s*)$//) {
$and = $1;
}
=cut
sub backquote_with_timeout
{
-local $realcmd = &translate_command($_[0]);
+my $realcmd = &translate_command($_[0]);
&webmin_debug_log('CMD', "cmd=$realcmd timeout=$_[1]")
if ($gconfig{'debug_what_cmd'});
-local $out;
-local $pid = &open_execute_command(OUT, "($realcmd) <$null_file", 1, $_[2]);
-local $start = time();
-local $timed_out = 0;
-local $linecount = 0;
+my $out;
+my $pid = &open_execute_command(OUT, "($realcmd) <$null_file", 1, $_[2]);
+my $start = time();
+my $timed_out = 0;
+my $linecount = 0;
while(1) {
- local $elapsed = time() - $start;
+ my $elapsed = time() - $start;
last if ($elapsed > $_[1]);
- local $rmask;
+ my $rmask;
vec($rmask, fileno(OUT), 1) = 1;
- local $sel = select($rmask, undef, undef, $_[1] - $elapsed);
+ my $sel = select($rmask, undef, undef, $_[1] - $elapsed);
last if (!$sel || $sel < 0);
- local $line = <OUT>;
+ my $line = <OUT>;
last if (!defined($line));
$out .= $line;
$linecount++;
$? = 0;
return undef;
}
-local $realcmd = &translate_command($_[0]);
+my $realcmd = &translate_command($_[0]);
&webmin_debug_log('CMD', "cmd=$realcmd") if ($gconfig{'debug_what_cmd'});
return `$realcmd`;
}
&additional_log('kill', $_[0], join(" ", @_[1..@_-1])) if (@_ > 1);
if ($gconfig{'os_type'} eq 'windows') {
# Emulate some kills with process.exe
- local $arg = $_[0] eq "KILL" ? "-k" :
- $_[0] eq "TERM" ? "-q" :
- $_[0] eq "STOP" ? "-s" :
- $_[0] eq "CONT" ? "-r" : undef;
- local $ok = 0;
+ my $arg = $_[0] eq "KILL" ? "-k" :
+ $_[0] eq "TERM" ? "-q" :
+ $_[0] eq "STOP" ? "-s" :
+ $_[0] eq "CONT" ? "-r" : undef;
+ my $ok = 0;
foreach my $p (@_[1..@_-1]) {
if ($p < 0) {
$ok ||= kill($_[0], $p);
print STDERR "Vetoing rename from $_[0] to $_[1]\n";
return 1;
}
-local $src = &translate_filename($_[0]);
-local $dst = &translate_filename($_[1]);
+my $src = &translate_filename($_[0]);
+my $dst = &translate_filename($_[1]);
&webmin_debug_log('RENAME', "src=$src dst=$dst")
if ($gconfig{'debug_what_ops'});
-local $ok = rename($src, $dst);
+my $ok = rename($src, $dst);
if (!$ok && $! !~ /permission/i) {
# Try the mv command, in case this is a cross-filesystem rename
if ($gconfig{'os_type'} eq 'windows') {
# Need to use rename
- local $out = &backquote_command("rename ".quotemeta($_[0])." ".quotemeta($_[1])." 2>&1");
+ my $out = &backquote_command("rename ".quotemeta($_[0]).
+ " ".quotemeta($_[1])." 2>&1");
$ok = !$?;
$! = $out if (!$ok);
}
else {
# Can use mv
- local $out = &backquote_command("mv ".quotemeta($_[0])." ".quotemeta($_[1])." 2>&1");
+ my $out = &backquote_command("mv ".quotemeta($_[0]).
+ " ".quotemeta($_[1])." 2>&1");
$ok = !$?;
$! = $out if (!$ok);
}
sub symlink_logged
{
&lock_file($_[1]);
-local $rv = &symlink_file($_[0], $_[1]);
+my $rv = &symlink_file($_[0], $_[1]);
&unlock_file($_[1]);
return $rv;
}
print STDERR "Vetoing symlink from $_[0] to $_[1]\n";
return 1;
}
-local $src = &translate_filename($_[0]);
-local $dst = &translate_filename($_[1]);
+my $src = &translate_filename($_[0]);
+my $dst = &translate_filename($_[1]);
&webmin_debug_log('SYMLINK', "src=$src dst=$dst")
if ($gconfig{'debug_what_ops'});
return symlink($src, $dst);
print STDERR "Vetoing link from $_[0] to $_[1]\n";
return 1;
}
-local $src = &translate_filename($_[0]);
-local $dst = &translate_filename($_[1]);
+my $src = &translate_filename($_[0]);
+my $dst = &translate_filename($_[1]);
&webmin_debug_log('LINK', "src=$src dst=$dst")
if ($gconfig{'debug_what_ops'});
unlink($dst); # make sure link works
=cut
sub make_dir
{
-local ($dir, $perms, $recur) = @_;
+my ($dir, $perms, $recur) = @_;
if (&is_readonly_mode()) {
print STDERR "Vetoing directory $dir\n";
return 1;
}
$dir = &translate_filename($dir);
-local $exists = -d $dir ? 1 : 0;
+my $exists = -d $dir ? 1 : 0;
return 1 if ($exists && $recur); # already exists
&webmin_debug_log('MKDIR', $dir) if ($gconfig{'debug_what_ops'});
-local $rv = mkdir($dir, $perms);
+my $rv = mkdir($dir, $perms);
if (!$rv && $recur) {
# Failed .. try mkdir -p
- local $param = $gconfig{'os_type'} eq 'windows' ? "" : "-p";
- local $ex = &execute_command("mkdir $param "."e_path($dir));
+ my $param = $gconfig{'os_type'} eq 'windows' ? "" : "-p";
+ my $ex = &execute_command("mkdir $param "."e_path($dir));
if ($ex) {
return 0;
}
=cut
sub set_ownership_permissions
{
-local ($user, $group, $perms, @files) = @_;
+my ($user, $group, $perms, @files) = @_;
if (&is_readonly_mode()) {
print STDERR "Vetoing permission changes on ",join(" ", @files),"\n";
return 1;
"file=$f user=$user group=$group perms=$perms");
}
}
-local $rv = 1;
+my $rv = 1;
if (defined($user)) {
- local $uid = $user !~ /^\d+$/ ? getpwnam($user) : $user;
- local $gid;
+ my $uid = $user !~ /^\d+$/ ? getpwnam($user) : $user;
+ my $gid;
if (defined($group)) {
$gid = $group !~ /^\d+$/ ? getgrnam($group) : $group;
}
else {
- local @uinfo = getpwuid($uid);
+ my @uinfo = getpwuid($uid);
$gid = $uinfo[3];
}
$rv = chown($uid, $gid, @files);
=cut
sub unlink_logged
{
-local %locked;
+my %locked;
foreach my $f (@_) {
if (!&test_lock($f)) {
&lock_file($f);
$locked{$f} = 1;
}
}
-local @rv = &unlink_file(@_);
+my @rv = &unlink_file(@_);
foreach my $f (@_) {
if ($locked{$f}) {
&unlock_file($f);
# Call del and rmdir commands
my $qm = $realf;
$qm =~ s/\//\\/g;
- local $out = `del /q "$qm" 2>&1`;
+ my $out = `del /q "$qm" 2>&1`;
if (!$?) {
$out = `rmdir "$qm" 2>&1`;
}
else {
# Use rm command
my $qm = quotemeta($realf);
- local $out = `rm -rf $qm 2>&1`;
+ my $out = `rm -rf $qm 2>&1`;
}
if ($?) {
$rv = 0;
sub copy_source_dest
{
return (1, undef) if (&is_readonly_mode());
-local ($src, $dst) = @_;
-local $ok = 1;
-local ($err, $out);
+my ($src, $dst) = @_;
+my $ok = 1;
+my ($err, $out);
&webmin_debug_log('COPY', "src=$src dst=$dst")
if ($gconfig{'debug_what_ops'});
if ($gconfig{'os_type'} eq 'windows') {
}
elsif (-d $src) {
# A directory .. need to copy with tar command
- local @st = stat($src);
+ my @st = stat($src);
unlink($dst);
mkdir($dst, 0755);
&set_ownership_permissions($st[4], $st[5], $st[2], $dst);
}
else {
# Can just copy with cp
- local $out = &backquote_logged("cp -p ".quotemeta($src).
- " ".quotemeta($dst)." 2>&1");
+ my $out = &backquote_logged("cp -p ".quotemeta($src).
+ " ".quotemeta($dst)." 2>&1");
if ($?) {
$ok = 0;
$err = $out;
=cut
sub remote_foreign_require
{
-local $call = { 'action' => 'require',
- 'module' => $_[1],
- 'file' => $_[2] };
-local $sn = &remote_session_name($_[0]);
+my $call = { 'action' => 'require',
+ 'module' => $_[1],
+ 'file' => $_[2] };
+my $sn = &remote_session_name($_[0]);
if ($remote_session{$sn}) {
$call->{'session'} = $remote_session{$sn};
}
else {
$call->{'newsession'} = 1;
}
-local $rv = &remote_rpc_call($_[0], $call);
+my $rv = &remote_rpc_call($_[0], $call);
if ($rv->{'session'}) {
$remote_session{$sn} = $rv->{'session'};
$remote_session_server{$sn} = $_[0];
sub remote_foreign_call
{
return undef if (&is_readonly_mode());
-local $sn = &remote_session_name($_[0]);
+my $sn = &remote_session_name($_[0]);
return &remote_rpc_call($_[0], { 'action' => 'call',
'module' => $_[1],
'func' => $_[2],
sub remote_eval
{
return undef if (&is_readonly_mode());
-local $sn = &remote_session_name($_[0]);
+my $sn = &remote_session_name($_[0]);
return &remote_rpc_call($_[0], { 'action' => 'eval',
'module' => $_[1],
'code' => $_[2],
sub remote_write
{
return undef if (&is_readonly_mode());
-local ($data, $got);
-local $sn = &remote_session_name($_[0]);
+my ($data, $got);
+my $sn = &remote_session_name($_[0]);
if (!$_[0] || $remote_server_version{$sn} >= 0.966) {
# Copy data over TCP connection
- local $rv = &remote_rpc_call($_[0],
- { 'action' => 'tcpwrite',
- 'file' => $_[2],
- 'name' => $_[3] } );
- local $error;
- local $serv = ref($_[0]) ? $_[0]->{'host'} : $_[0];
+ my $rv = &remote_rpc_call($_[0], { 'action' => 'tcpwrite',
+ 'file' => $_[2],
+ 'name' => $_[3] } );
+ my $error;
+ my $serv = ref($_[0]) ? $_[0]->{'host'} : $_[0];
&open_socket($serv || "localhost", $rv->[1], TWRITE, \$error);
return &$remote_error_handler("Failed to transfer file : $error")
if ($error);
=cut
sub remote_read
{
-local $sn = &remote_session_name($_[0]);
+my $sn = &remote_session_name($_[0]);
if (!$_[0] || $remote_server_version{$sn} >= 0.966) {
# Copy data over TCP connection
- local $rv = &remote_rpc_call($_[0],
- { 'action' => 'tcpread', 'file' => $_[2] } );
+ my $rv = &remote_rpc_call($_[0], { 'action' => 'tcpread',
+ 'file' => $_[2] } );
if (!$rv->[0]) {
return &$remote_error_handler("Failed to transfer file : $rv->[1]");
}
- local $error;
- local $serv = ref($_[0]) ? $_[0]->{'host'} : $_[0];
+ my $error;
+ my $serv = ref($_[0]) ? $_[0]->{'host'} : $_[0];
&open_socket($serv || "localhost", $rv->[1], TREAD, \$error);
return &$remote_error_handler("Failed to transfer file : $error")
if ($error);
- local $got;
+ my $got;
open(FILE, ">$_[1]");
while(read(TREAD, $got, 1024) > 0) {
print FILE $got;
}
else {
# Just get data as return value
- local $d = &remote_rpc_call($_[0], { 'action' => 'read',
- 'file' => $_[2],
- 'session' => $remote_session{$sn} });
+ my $d = &remote_rpc_call($_[0], { 'action' => 'read',
+ 'file' => $_[2],
+ 'session' => $remote_session{$sn} });
open(FILE, ">$_[1]");
print FILE $d;
close(FILE);
=cut
sub remote_finished
{
-foreach $sn (keys %remote_session) {
- local $server = $remote_session_server{$sn};
+foreach my $sn (keys %remote_session) {
+ my $server = $remote_session_server{$sn};
&remote_rpc_call($server, { 'action' => 'quit',
'session' => $remote_session{$sn} } );
delete($remote_session{$sn});
=cut
sub remote_rpc_call
{
-local $serv;
-local $sn = &remote_session_name($_[0]);
+my $serv;
+my $sn = &remote_session_name($_[0]);
if (ref($_[0])) {
# Server structure was given
$serv = $_[0];
}
# Work out the username and password
-local ($user, $pass);
+my ($user, $pass);
if ($serv->{'sameuser'}) {
$user = $remote_user;
defined($remote_pass) || return &$remote_error_handler(
# Make TCP connection call to fastrpc.cgi
if (!$fast_fh_cache{$sn} && $sn) {
# Need to open the connection
- local $con = &make_http_connection(
+ my $con = &make_http_connection(
$serv->{'host'}, $serv->{'port'}, $serv->{'ssl'},
"POST", "/fastrpc.cgi");
return &$remote_error_handler(
if (!ref($con));
&write_http_connection($con, "Host: $serv->{'host'}\r\n");
&write_http_connection($con, "User-agent: Webmin\r\n");
- local $auth = &encode_base64("$user:$pass");
+ my $auth = &encode_base64("$user:$pass");
$auth =~ tr/\n//d;
&write_http_connection($con, "Authorization: basic $auth\r\n");
&write_http_connection($con, "Content-length: ",
&write_http_connection($con, $tostr);
# read back the response
- local $line = &read_http_connection($con);
+ my $line = &read_http_connection($con);
$line =~ tr/\r\n//d;
if ($line =~ /^HTTP\/1\..\s+401\s+/) {
return &$remote_error_handler("Login to RPC server as $user rejected");
$line =~ /^1\s+(\S+)\s+(\S+)/) {
# Started ok .. connect and save SID
&close_http_connection($con);
- local ($port, $sid, $version, $error) = ($1, $2, $3);
+ my ($port, $sid, $version, $error) = ($1, $2, $3);
&open_socket($serv->{'host'}, $port, $sid, \$error);
return &$remote_error_handler("Failed to connect to fastrpc.cgi : $error")
if ($error);
$ENV{'REQUEST_METHOD'} = 'GET';
$ENV{'SCRIPT_NAME'} = '/fastrpc.cgi';
$ENV{'SERVER_ROOT'} ||= $root_directory;
- local %acl;
+ my %acl;
if ($base_remote_user ne 'root' &&
$base_remote_user ne 'admin') {
# Need to fake up a login for the CGI!
}
}
close(RPCOUTw);
- local $line;
+ my $line;
do {
($line = <RPCOUTr>) =~ tr/\r\n//d;
} while($line);
elsif ($line =~ /^1\s+(\S+)\s+(\S+)/) {
# Started ok .. connect and save SID
close(SOCK);
- local ($port, $sid, $error) = ($1, $2, undef);
+ my ($port, $sid, $error) = ($1, $2, undef);
&open_socket("localhost", $port, $sid, \$error);
return &$remote_error_handler("Failed to connect to fastrpc.cgi : $error") if ($error);
$fast_fh_cache{$sn} = $sid;
}
}
# Got a connection .. send off the request
- local $fh = $fast_fh_cache{$sn};
- local $tostr = &serialise_variable($_[1]);
+ my $fh = $fast_fh_cache{$sn};
+ my $tostr = &serialise_variable($_[1]);
print $fh length($tostr)," $fh\n";
print $fh $tostr;
- local $rlen = int(<$fh>);
- local ($fromstr, $got);
+ my $rlen = int(<$fh>);
+ my ($fromstr, $got);
while(length($fromstr) < $rlen) {
return &$remote_error_handler("Failed to read from fastrpc.cgi")
if (read($fh, $got, $rlen - length($fromstr)) <= 0);
$fromstr .= $got;
}
- local $from = &unserialise_variable($fromstr);
+ my $from = &unserialise_variable($fromstr);
if (!$from) {
return &$remote_error_handler("Remote Webmin error");
}
}
else {
# Call rpc.cgi on remote server
- local $tostr = &serialise_variable($_[1]);
- local $error = 0;
- local $con = &make_http_connection($serv->{'host'}, $serv->{'port'},
- $serv->{'ssl'}, "POST", "/rpc.cgi");
+ my $tostr = &serialise_variable($_[1]);
+ my $error = 0;
+ my $con = &make_http_connection($serv->{'host'}, $serv->{'port'},
+ $serv->{'ssl'}, "POST", "/rpc.cgi");
return &$remote_error_handler("Failed to connect to $serv->{'host'} : $con") if (!ref($con));
&write_http_connection($con, "Host: $serv->{'host'}\r\n");
&write_http_connection($con, "User-agent: Webmin\r\n");
- local $auth = &encode_base64("$user:$pass");
+ my $auth = &encode_base64("$user:$pass");
$auth =~ tr/\n//d;
&write_http_connection($con, "Authorization: basic $auth\r\n");
&write_http_connection($con, "Content-length: ",length($tostr),"\r\n");
&write_http_connection($con, $tostr);
# read back the response
- local $line = &read_http_connection($con);
+ my $line = &read_http_connection($con);
$line =~ tr/\r\n//d;
if ($line =~ /^HTTP\/1\..\s+401\s+/) {
return &$remote_error_handler("Login to RPC server as $user rejected");
$line = &read_http_connection($con);
$line =~ tr/\r\n//d;
} while($line);
- local $fromstr;
+ my $fromstr;
while($line = &read_http_connection($con)) {
$fromstr .= $line;
}
close(SOCK);
- local $from = &unserialise_variable($fromstr);
+ my $from = &unserialise_variable($fromstr);
return &$remote_error_handler("Invalid RPC login to $serv->{'host'}") if (!$from->{'status'});
if (defined($from->{'arv'})) {
return @{$from->{'arv'}};
=cut
sub remote_multi_callback
{
-local ($servs, $parallel, $func, $args, $rets, $errs, $mod, $lib) = @_;
+my ($servs, $parallel, $func, $args, $rets, $errs, $mod, $lib) = @_;
&remote_error_setup(\&remote_multi_callback_error);
# Call the functions
-local $p = 0;
+my $p = 0;
foreach my $g (@$servs) {
- local ($rh = "READ$p", $wh = "WRITE$p");
+ my $rh = "READ$p";
+ my $wh = "WRITE$p";
pipe($rh, $wh);
if (!fork()) {
close($rh);
}
# Call the function
- local $a = ref($args) ? $args->[$p] : $args;
- local $rv = &$func($g, $a);
+ my $a = ref($args) ? $args->[$p] : $args;
+ my $rv = &$func($g, $a);
# Return the result
print $wh &serialise_variable(
# Read back the results
$p = 0;
foreach my $g (@$servs) {
- local $rh = "READ$p";
- local $line = <$rh>;
+ my $rh = "READ$p";
+ my $line = <$rh>;
if (!$line) {
$errs->[$p] = "Failed to read response from $g->{'host'}";
}
else {
- local $rv = &unserialise_variable($line);
+ my $rv = &unserialise_variable($line);
close($rh);
$rets->[$p] = $rv->[0];
$errs->[$p] = $rv->[1];
if (!defined($_[0])) {
return 'UNDEF';
}
-local $r = ref($_[0]);
-local $rv;
+my $r = ref($_[0]);
+my $rv;
if (!$r) {
$rv = &urlize($_[0]);
}
=cut
sub unserialise_variable
{
-local @v = split(/,/, $_[0]);
-local ($rv, $i);
+my @v = split(/,/, $_[0]);
+my $rv;
if ($v[0] eq 'VAL') {
@v = split(/,/, $_[0], -1);
$rv = &un_urlize($v[1]);
}
elsif ($v[0] eq 'ARRAY') {
$rv = [ ];
- for($i=1; $i<@v; $i++) {
+ for(my $i=1; $i<@v; $i++) {
push(@$rv, &unserialise_variable(&un_urlize($v[$i])));
}
}
elsif ($v[0] eq 'HASH') {
$rv = { };
- for($i=1; $i<@v; $i+=2) {
+ for(my $i=1; $i<@v; $i+=2) {
$rv->{&unserialise_variable(&un_urlize($v[$i]))} =
&unserialise_variable(&un_urlize($v[$i+1]));
}
}
elsif ($v[0] =~ /^OBJECT\s+(.*)$/) {
# An object hash that we have to re-bless
- local $cls = $1;
+ my $cls = $1;
$rv = { };
- for($i=1; $i<@v; $i+=2) {
+ for(my $i=1; $i<@v; $i+=2) {
$rv->{&unserialise_variable(&un_urlize($v[$i]))} =
&unserialise_variable(&un_urlize($v[$i+1]));
}
=cut
sub other_groups
{
-local (@rv, @g);
+my ($user) = @_;
+my @rv;
setgrent();
-while(@g = getgrent()) {
- local @m = split(/\s+/, $g[3]);
- push(@rv, $g[2]) if (&indexof($_[0], @m) >= 0);
+while(my @g = getgrent()) {
+ my @m = split(/\s+/, $g[3]);
+ push(@rv, $g[2]) if (&indexof($user, @m) >= 0);
}
endgrent() if ($gconfig{'os_type'} ne 'hpux');
return @rv;
{
return &theme_date_chooser_button(@_)
if (defined(&theme_date_chooser_button));
-local ($w, $h) = (250, 225);
+my ($w, $h) = (250, 225);
if ($gconfig{'db_sizedate'}) {
($w, $h) = split(/x/, $gconfig{'db_sizedate'});
}
=cut
sub help_file
{
-local $mdir = &module_root_directory($_[0]);
-local $dir = "$mdir/help";
+my $mdir = &module_root_directory($_[0]);
+my $dir = "$mdir/help";
foreach my $o (@lang_order_list) {
- local $lang = "$dir/$_[1].$current_lang.html";
+ my $lang = "$dir/$_[1].$current_lang.html";
return $lang if (-r $lang);
}
return "$dir/$_[1].html";
{
if (!$main::done_seed_random) {
if (open(RANDOM, "/dev/urandom")) {
- local $buf;
+ my $buf;
read(RANDOM, $buf, 4);
close(RANDOM);
srand(time() ^ $$ ^ $buf);
=cut
sub disk_usage_kb
{
-local $dir = &translate_filename($_[0]);
-local $out;
-local $ex = &execute_command("du -sk ".quotemeta($dir), undef, \$out, undef,
- 0, 1);
+my $dir = &translate_filename($_[0]);
+my $out;
+my $ex = &execute_command("du -sk ".quotemeta($dir), undef, \$out, undef, 0, 1);
if ($ex) {
- &execute_command("du -s ".quotemeta($dir), undef, \$out, undef,
- 0, 1);
+ &execute_command("du -s ".quotemeta($dir), undef, \$out, undef, 0, 1);
}
return $out =~ /^([0-9]+)/ ? $1 : "???";
}
=cut
sub recursive_disk_usage
{
-local $dir = &translate_filename($_[0]);
+my $dir = &translate_filename($_[0]);
if (-l $dir) {
return 0;
}
elsif (!-d $dir) {
- local @st = stat($dir);
+ my @st = stat($dir);
return $st[7];
}
else {
- local $rv = 0;
+ my $rv = 0;
opendir(DIR, $dir);
- local @files = readdir(DIR);
+ my @files = readdir(DIR);
closedir(DIR);
foreach my $f (@files) {
next if ($f eq "." || $f eq "..");
=cut
sub help_search_link
{
-local %acl;
if (&foreign_available("man") && !$tconfig{'nosearch'}) {
- local $for = &urlize(shift(@_));
+ my $for = &urlize(shift(@_));
return "<a href='$gconfig{'webprefix'}/man/search.cgi?".
join("&", map { "section=$_" } @_)."&".
- "for=$for&exact=1&check=$module_name'>".
+ "for=$for&exact=1&check=".&get_module_name()."'>".
$text{'helpsearch'}."</a>\n";
}
else {
=cut
sub make_http_connection
{
-local ($host, $port, $ssl, $method, $page, $headers) = @_;
-local $htxt;
+my ($host, $port, $ssl, $method, $page, $headers) = @_;
+my $htxt;
if ($headers) {
foreach my $h (@$headers) {
$htxt .= $h->[0].": ".$h->[1]."\r\n";
if (&is_readonly_mode()) {
return "HTTP connections not allowed in readonly mode";
}
-local $rv = { 'fh' => time().$$ };
+my $rv = { 'fh' => time().$$ };
if ($ssl) {
# Connect using SSL
eval "use Net::SSLeay";
return "Failed to create SSL context";
$rv->{'ssl_con'} = Net::SSLeay::new($rv->{'ssl_ctx'}) ||
return "Failed to create SSL connection";
- local $connected;
+ my $connected;
if ($gconfig{'http_proxy'} =~ /^http:\/\/(\S+):(\d+)/ &&
!&no_proxy($host)) {
# Via proxy
- local $error;
+ my $error;
&open_socket($1, $2, $rv->{'fh'}, \$error);
if (!$error) {
# Connected OK
- local $fh = $rv->{'fh'};
+ my $fh = $rv->{'fh'};
print $fh "CONNECT $host:$port HTTP/1.0\r\n";
if ($gconfig{'proxy_user'}) {
- local $auth = &encode_base64(
+ my $auth = &encode_base64(
"$gconfig{'proxy_user'}:".
"$gconfig{'proxy_pass'}");
$auth =~ tr/\r\n//d;
print $fh "Proxy-Authorization: Basic $auth\r\n";
}
print $fh "\r\n";
- local $line = <$fh>;
+ my $line = <$fh>;
if ($line =~ /^HTTP(\S+)\s+(\d+)\s+(.*)/) {
return "Proxy error : $3" if ($2 != 200);
}
}
if (!$connected) {
# Direct connection
- local $error;
+ my $error;
&open_socket($host, $port, $rv->{'fh'}, \$error);
return $error if ($error);
}
Net::SSLeay::set_fd($rv->{'ssl_con'}, fileno($rv->{'fh'}));
Net::SSLeay::connect($rv->{'ssl_con'}) ||
return "SSL connect() failed";
- local $rtxt = "$method $page HTTP/1.0\r\n".$htxt;
+ my $rtxt = "$method $page HTTP/1.0\r\n".$htxt;
Net::SSLeay::write($rv->{'ssl_con'}, $rtxt);
}
else {
# Plain HTTP request
- local $connected;
+ my $connected;
if ($gconfig{'http_proxy'} =~ /^http:\/\/(\S+):(\d+)/ &&
!&no_proxy($host)) {
# Via a proxy
- local $error;
+ my $error;
&open_socket($1, $2, $rv->{'fh'}, \$error);
if (!$error) {
# Connected OK
$connected = 1;
- local $fh = $rv->{'fh'};
- local $rtxt = "$method http://$host:$port$page HTTP/1.0\r\n";
+ my $fh = $rv->{'fh'};
+ my $rtxt = $method." ".
+ "http://$host:$port$page HTTP/1.0\r\n";
if ($gconfig{'proxy_user'}) {
- local $auth = &encode_base64(
+ my $auth = &encode_base64(
"$gconfig{'proxy_user'}:".
"$gconfig{'proxy_pass'}");
$auth =~ tr/\r\n//d;
}
if (!$connected) {
# Connecting directly
- local $error;
+ my $error;
&open_socket($host, $port, $rv->{'fh'}, \$error);
return $error if ($error);
- local $fh = $rv->{'fh'};
- local $rtxt = "$method $page HTTP/1.0\r\n".$htxt;
+ my $fh = $rv->{'fh'};
+ my $rtxt = "$method $page HTTP/1.0\r\n".$htxt;
print $fh $rtxt;
}
}
=cut
sub read_http_connection
{
-local $h = $_[0];
-local $rv;
+my ($h) = @_;
+my $rv;
if ($h->{'ssl_con'}) {
if (!$_[1]) {
- local ($idx, $more);
+ my ($idx, $more);
while(($idx = index($h->{'buffer'}, "\n")) < 0) {
# need to read more..
if (!($more = Net::SSLeay::read($h->{'ssl_con'}))) {
read($h->{'fh'}, $rv, $_[1]) > 0 || return undef;
}
else {
- local $fh = $h->{'fh'};
+ my $fh = $h->{'fh'};
$rv = <$fh>;
}
}
=cut
sub write_http_connection
{
-local $h = shift(@_);
-local $fh = $h->{'fh'};
-local $allok = 1;
+my $h = shift(@_);
+my $fh = $h->{'fh'};
+my $allok = 1;
if ($h->{'ssl_ctx'}) {
- foreach (@_) {
- my $ok = Net::SSLeay::write($h->{'ssl_con'}, $_);
+ foreach my $s (@_) {
+ my $ok = Net::SSLeay::write($h->{'ssl_con'}, $s);
$allok = 0 if (!$ok);
}
}
=cut
sub clean_environment
{
-local ($k, $e);
%UNCLEAN_ENV = %ENV;
-foreach $k (keys %ENV) {
+foreach my $k (keys %ENV) {
if ($k =~ /^(HTTP|VIRTUALSERVER|QUOTA|USERADMIN)_/) {
delete($ENV{$k});
}
}
-foreach $e ('WEBMIN_CONFIG', 'SERVER_NAME', 'CONTENT_TYPE', 'REQUEST_URI',
+foreach my $e ('WEBMIN_CONFIG', 'SERVER_NAME', 'CONTENT_TYPE', 'REQUEST_URI',
'PATH_INFO', 'WEBMIN_VAR', 'REQUEST_METHOD', 'GATEWAY_INTERFACE',
'QUERY_STRING', 'REMOTE_USER', 'SERVER_SOFTWARE', 'SERVER_PROTOCOL',
'REMOTE_HOST', 'SERVER_PORT', 'DOCUMENT_ROOT', 'SERVER_ROOT',
}
elsif ($_[0] == 3) {
# Got data update
- local $sp = $progress_callback_prefix.(" " x 5);
+ my $sp = $progress_callback_prefix.(" " x 5);
if ($progress_size) {
# And we have a size to compare against
- local $st = int(($_[1] * 10) / $progress_size);
- local $time_now = time();
+ my $st = int(($_[1] * 10) / $progress_size);
+ my $time_now = time();
if ($st != $progress_step ||
$time_now - $last_progress_time > 60) {
# Show progress every 10% or 60 seconds
$ENV{'USER'} = $ENV{'LOGNAME'} = $remote_user;
$ENV{'HOME'} = $remote_user_info[7];
}
+# Export global variables to caller
+if ($main::export_to_caller) {
+ my ($callpkg) = caller();
+ eval "\@${callpkg}::remote_user_info = \@remote_user_info";
+ }
}
=head2 create_user_config_dirs
sub create_user_config_dirs
{
return if (!$gconfig{'userconfig'});
-local @uinfo = @remote_user_info ? @remote_user_info : getpwnam($remote_user);
+my @uinfo = @remote_user_info ? @remote_user_info : getpwnam($remote_user);
return if (!@uinfo || !$uinfo[7]);
&create_missing_homedir(\@uinfo);
$user_config_directory = "$uinfo[7]/$gconfig{'userconfig'}";
chown($uinfo[2], $uinfo[3], $user_config_directory);
}
}
-if ($module_name) {
- $user_module_config_directory = "$user_config_directory/$module_name";
+if (&get_module_name()) {
+ $user_module_config_directory = $user_config_directory."/".
+ &get_module_name();
if (!-d $user_module_config_directory) {
mkdir($user_module_config_directory, 0755) ||
&error("Failed to create $user_module_config_directory : $!");
&read_file_cached("$user_module_config_directory/config",
\%userconfig);
}
+
+# Export global variables to caller
+if ($main::export_to_caller) {
+ my ($callpkg) = caller();
+ foreach my $v ('$user_config_directory',
+ '$user_module_config_directory', '%userconfig') {
+ my ($vt, $vn) = split('', $v, 2);
+ eval "${vt}${callpkg}::${vn} = ${vt}${vn}";
+ }
+ }
}
=head2 create_missing_homedir(&uinfo)
=cut
sub create_missing_homedir
{
-local ($uinfo) = @_;
+my ($uinfo) = @_;
if (!-e $uinfo->[7] && $gconfig{'create_homedir'}) {
# Use has no home dir .. make one
system("mkdir -p ".quotemeta($uinfo->[7]));
=cut
sub filter_javascript
{
-local $rv = $_[0];
+my ($rv) = @_;
$rv =~ s/<\s*script[^>]*>([\000-\377]*?)<\s*\/script\s*>//gi;
$rv =~ s/(on(Abort|Blur|Change|Click|DblClick|DragDrop|Error|Focus|KeyDown|KeyPress|KeyUp|Load|MouseDown|MouseMove|MouseOut|MouseOver|MouseUp|Move|Reset|Resize|Select|Submit|Unload)=)/x$1/gi;
$rv =~ s/(javascript:)/x$1/gi;
=cut
sub resolve_links
{
-local $path = $_[0];
+my ($path) = @_;
$path =~ s/\/+/\//g;
$path =~ s/\/$// if ($path ne "/");
-local @p = split(/\/+/, $path);
+my @p = split(/\/+/, $path);
shift(@p);
-local $i;
-for($i=0; $i<@p; $i++) {
- local $sofar = "/".join("/", @p[0..$i]);
- local $lnk = readlink($sofar);
+for(my $i=0; $i<@p; $i++) {
+ my $sofar = "/".join("/", @p[0..$i]);
+ my $lnk = readlink($sofar);
if ($lnk =~ /^\//) {
# Link is absolute..
return &resolve_links($lnk."/".join("/", @p[$i+1 .. $#p]));
=cut
sub simplify_path
{
-local($dir, @bits, @fixedbits, $b);
-$dir = $_[0];
+my ($dir) = @_;
$dir =~ s/^\/+//g;
$dir =~ s/\/+$//g;
-@bits = split(/\/+/, $dir);
-@fixedbits = ();
+my @bits = split(/\/+/, $dir);
+my @fixedbits = ();
$_[1] = 0;
-foreach $b (@bits) {
+foreach my $b (@bits) {
if ($b eq ".") {
# Do nothing..
}
push(@fixedbits, $b);
}
}
-return "/" . join('/', @fixedbits);
+return "/".join('/', @fixedbits);
}
=head2 same_file(file1, file2)
{
return 1 if ($_[0] eq $_[1]);
return 0 if ($_[0] !~ /^\// || $_[1] !~ /^\//);
-local @stat1 = $stat_cache{$_[0]} ? @{$stat_cache{$_[0]}}
- : (@{$stat_cache{$_[0]}} = stat($_[0]));
-local @stat2 = $stat_cache{$_[1]} ? @{$stat_cache{$_[1]}}
- : (@{$stat_cache{$_[1]}} = stat($_[1]));
+my @stat1 = $stat_cache{$_[0]} ? @{$stat_cache{$_[0]}}
+ : (@{$stat_cache{$_[0]}} = stat($_[0]));
+my @stat2 = $stat_cache{$_[1]} ? @{$stat_cache{$_[1]}}
+ : (@{$stat_cache{$_[1]}} = stat($_[1]));
return 0 if (!@stat1 || !@stat2);
return $stat1[0] == $stat2[0] && $stat1[1] == $stat2[1];
}
{
return @{$_[0]} if (!@{$_[1]});
-local %mods;
-map { $mods{$_->{'dir'}}++ } @{$_[0]};
-local @uinfo = @remote_user_info;
+my %mods = map { $_->{'dir'}, 1 } @{$_[0]};
+my @uinfo = @remote_user_info;
@uinfo = getpwnam($remote_user) if (!@uinfo);
-foreach $u (@{$_[1]}) {
- local $applies;
+foreach my $u (@{$_[1]}) {
+ my $applies;
if ($u->[0] eq "*" || $u->[0] eq $remote_user) {
$applies++;
}
elsif ($u->[0] =~ /^\@(.*)$/) {
# Check for group membership
- local @ginfo = getgrnam($1);
+ my @ginfo = getgrnam($1);
$applies++ if (@ginfo && ($ginfo[2] == $uinfo[3] ||
&indexof($remote_user, split(/\s+/, $ginfo[3])) >= 0));
}
$applies++;
}
elsif (/^\@(.*)$/) {
- local @ginfo = getgrnam($1);
+ my @ginfo = getgrnam($1);
$applies++
if (@ginfo && ($ginfo[2] == $uinfo[3] ||
&indexof($remote_user,
=cut
sub get_available_module_infos
{
-local (%acl, %uacl);
+my (%acl, %uacl);
&read_acl(\%acl, \%uacl);
-local $risk = $gconfig{'risk_'.$base_remote_user};
-local ($minfo, @rv, $m);
-foreach $minfo (&get_all_module_infos($_[0])) {
+my $risk = $gconfig{'risk_'.$base_remote_user};
+my @rv;
+foreach my $minfo (&get_all_module_infos($_[0])) {
next if (!&check_os_support($minfo));
if ($risk) {
# Check module risk level
}
# Check usermod restrictions
-local @usermods = &list_usermods();
+my @usermods = &list_usermods();
@rv = sort { $a->{'desc'} cmp $b->{'desc'} }
&available_usermods(\@rv, \@usermods);
# Check RBAC restrictions
-local @rbacrv;
-foreach $m (@rv) {
+my @rbacrv;
+foreach my $m (@rv) {
if (&supports_rbac($m->{'dir'}) &&
&use_rbac_module_acl(undef, $m->{'dir'})) {
local $rbacs = &get_rbac_module_acl($remote_user,
}
# Check theme vetos
-local @themerv;
+my @themerv;
if (defined(&theme_foreign_available)) {
- foreach $m (@rbacrv) {
+ foreach my $m (@rbacrv) {
if (&theme_foreign_available($m->{'dir'})) {
push(@themerv, $m);
}
}
# Check licence module vetos
-local @licrv;
+my @licrv;
if ($main::licence_module) {
- foreach $m (@themerv) {
+ foreach my $m (@themerv) {
if (&foreign_call($main::licence_module,
"check_module_licence", $m->{'dir'})) {
push(@licrv, $m);
=cut
sub get_visible_module_infos
{
-local ($nocache) = @_;
-local $pn = &get_product_name();
+my ($nocache) = @_;
+my $pn = &get_product_name();
return grep { !$_->{'hidden'} &&
!$_->{$pn.'_hidden'} } &get_available_module_infos($nocache);
}
=cut
sub get_visible_modules_categories
{
-local ($nocache) = @_;
-local @mods = &get_visible_module_infos($nocache);
-local @unmods;
+my ($nocache) = @_;
+my @mods = &get_visible_module_infos($nocache);
+my @unmods;
if (&get_product_name() eq 'webmin') {
@unmods = grep { $_->{'installed'} eq '0' } @mods;
@mods = grep { $_->{'installed'} ne '0' } @mods;
}
-local %cats = &list_categories(\@mods);
-local @rv;
+my %cats = &list_categories(\@mods);
+my @rv;
foreach my $c (keys %cats) {
- local $cat = { 'code' => $c || 'other',
- 'desc' => $cats{$c} };
+ my $cat = { 'code' => $c || 'other',
+ 'desc' => $cats{$c} };
$cat->{'modules'} = [ grep { $_->{'category'} eq $c } @mods ];
push(@rv, $cat);
}
($a->{'code'} eq "others" ? "" : $a->{'code'}) } @rv;
if (@unmods) {
# Add un-installed modules in magic category
- local $cat = { 'code' => 'unused',
- 'desc' => $text{'main_unused'},
- 'unused' => 1,
- 'modules' => \@unmods };
+ my $cat = { 'code' => 'unused',
+ 'desc' => $text{'main_unused'},
+ 'unused' => 1,
+ 'modules' => \@unmods };
push(@rv, $cat);
}
return @rv;
=cut
sub is_under_directory
{
-local ($dir, $file) = @_;
+my ($dir, $file) = @_;
return 1 if ($dir eq "/");
return 0 if ($file =~ /\.\./);
-local $ld = &resolve_links($dir);
+my $ld = &resolve_links($dir);
if ($ld ne $dir) {
return &resolve_links($ld, $file);
}
-local $lp = &resolve_links($file);
+my $lp = &resolve_links($file);
if ($lp ne $file) {
return &is_under_directory($dir, $lp);
}
{
if ($_[0] =~ /^(http|https):\/\/([^:\/]+)(:(\d+))?(\/\S*)?$/) {
# An absolute URL
- local $ssl = $1 eq 'https';
+ my $ssl = $1 eq 'https';
return ($2, $3 ? $4 : $ssl ? 443 : 80, $5 || "/", $ssl);
}
elsif (!$_[1]) {
}
else {
# A relative to the directory URL
- local $page = $_[3];
+ my $page = $_[3];
$page =~ s/[^\/]+$//;
return ($_[1], $_[2], $page.$_[0], $_[4]);
}
=cut
sub entities_to_ascii
{
-local $str = $_[0];
-local $emap = &load_entities_map();
+my ($str) = @_;
+my $emap = &load_entities_map();
$str =~ s/&([a-z]+);/chr($emap->{$1})/ge;
$str =~ s/&#(\d+);/chr($1)/ge;
return $str;
=cut
sub get_charset
{
-local $charset = defined($gconfig{'charset'}) ? $gconfig{'charset'} :
+my $charset = defined($gconfig{'charset'}) ? $gconfig{'charset'} :
$current_lang_info->{'charset'} ?
$current_lang_info->{'charset'} : $default_charset;
return $charset;
return $gconfig{'hostnamedisplay'};
}
else {
- local $h = $ENV{'HTTP_HOST'};
+ my $h = $ENV{'HTTP_HOST'};
$h =~ s/:\d+//g;
if ($gconfig{'hostnamemode'} == 2) {
$h =~ s/^(www|ftp|mail)\.//i;
=cut
sub save_module_config
{
-local $c = $_[0] || \%config;
-local $m = defined($_[1]) ? $_[1] : $module_name;
+my $c = $_[0] || { &get_module_variable('%config') };
+my $m = defined($_[1]) ? $_[1] : &get_module_name();
&write_file("$config_directory/$m/config", $c);
}
=cut
sub save_user_module_config
{
-local $c = $_[0] || \%userconfig;
-local $m = $_[1] || $module_name;
-local $ucd = $user_config_directory;
+my $c = $_[0] || { &get_module_variable('%userconfig') };
+my $m = $_[1] || &get_module_name();
+my $ucd = $user_config_directory;
if (!$ucd) {
- local @uinfo = @remote_user_info ? @remote_user_info
- : getpwnam($remote_user);
+ my @uinfo = @remote_user_info ? @remote_user_info
+ : getpwnam($remote_user);
return if (!@uinfo || !$uinfo[7]);
$ucd = "$uinfo[7]/$gconfig{'userconfig'}";
}
=cut
sub nice_size
{
-local ($units, $uname);
+my ($units, $uname);
if (abs($_[0]) > 1024*1024*1024*1024 || $_[1] >= 1024*1024*1024*1024) {
$units = 1024*1024*1024*1024;
$uname = "TB";
$units = 1;
$uname = "bytes";
}
-local $sz = sprintf("%.2f", ($_[0]*1.0 / $units));
+my $sz = sprintf("%.2f", ($_[0]*1.0 / $units));
$sz =~ s/\.00$//;
return $sz." ".$uname;
}
=cut
sub get_perl_path
{
-local $rv;
if (open(PERL, "$config_directory/perl-path")) {
+ my $rv;
chop($rv = <PERL>);
close(PERL);
return $rv;
=cut
sub get_goto_module
{
-local @mods = $_[0] ? @{$_[0]} : &get_visible_module_infos();
+my @mods = $_[0] ? @{$_[0]} : &get_visible_module_infos();
if ($gconfig{'gotomodule'}) {
- local ($goto) = grep { $_->{'dir'} eq $gconfig{'gotomodule'} } @mods;
+ my ($goto) = grep { $_->{'dir'} eq $gconfig{'gotomodule'} } @mods;
return $goto if ($goto);
}
if (@mods == 1 && $gconfig{'gotoone'}) {
sub select_all_link
{
return &theme_select_all_link(@_) if (defined(&theme_select_all_link));
-local ($field, $form, $text) = @_;
+my ($field, $form, $text) = @_;
$form = int($form);
$text ||= $text{'ui_selall'};
return "<a class='select_all' href='#' onClick='document.forms[$form].$field.checked = true; for(i=0; i<document.forms[$form].$field.length; i++) { document.forms[$form].${field}[i].checked = true; } return false'>$text</a>";
sub select_invert_link
{
return &theme_select_invert_link(@_) if (defined(&theme_select_invert_link));
-local ($field, $form, $text) = @_;
+my ($field, $form, $text) = @_;
$form = int($form);
$text ||= $text{'ui_selinv'};
return "<a class='select_invert' href='#' onClick='document.forms[$form].$field.checked = !document.forms[$form].$field.checked; for(i=0; i<document.forms[$form].$field.length; i++) { document.forms[$form].${field}[i].checked = !document.forms[$form].${field}[i].checked; } return false'>$text</a>";
sub select_rows_link
{
return &theme_select_rows_link(@_) if (defined(&theme_select_rows_link));
-local ($field, $form, $text, $rows) = @_;
+my ($field, $form, $text, $rows) = @_;
$form = int($form);
-local $js = "var sel = { ".join(",", map { "\""."e_escape($_)."\":1" } @$rows)." }; ";
+my $js = "var sel = { ".join(",", map { "\""."e_escape($_)."\":1" } @$rows)." }; ";
$js .= "for(var i=0; i<document.forms[$form].${field}.length; i++) { var r = document.forms[$form].${field}[i]; r.checked = sel[r.value]; } ";
$js .= "return false;";
return "<a href='#' onClick='$js'>$text</a>";
sub check_pid_file
{
open(PIDFILE, $_[0]) || return undef;
close(PIDFILE);
$pid =~ /^\s*(\d+)/ || return undef;
kill(0, $1) || return undef;
=cut
sub get_mod_lib
{
-local $lib;
-if (-r "$module_root_directory/$module_name-$gconfig{'os_type'}-$gconfig{'os_version'}-lib.pl") {
- return "$module_name-$gconfig{'os_type'}-$gconfig{'os_version'}-lib.pl";
+my $mn = &get_module_name();
+my $md = &module_root_directory($mn);
+if (-r "$md/$mn-$gconfig{'os_type'}-$gconfig{'os_version'}-lib.pl") {
+ return "$mn-$gconfig{'os_type'}-$gconfig{'os_version'}-lib.pl";
}
-elsif (-r "$module_root_directory/$module_name-$gconfig{'os_type'}-lib.pl") {
- return "$module_name-$gconfig{'os_type'}-lib.pl";
+elsif (-r "$md/$mn-$gconfig{'os_type'}-lib.pl") {
+ return "$mn-$gconfig{'os_type'}-lib.pl";
}
-elsif (-r "$module_root_directory/$module_name-generic-lib.pl") {
- return "$module_name-generic-lib.pl";
+elsif (-r "$md/$mn-generic-lib.pl") {
+ return "$mn-generic-lib.pl";
}
else {
return "";
=cut
sub module_root_directory
{
-local $d = ref($_[0]) ? $_[0]->{'dir'} : $_[0];
+my $d = ref($_[0]) ? $_[0]->{'dir'} : $_[0];
if (@root_directories > 1) {
- local $r;
- foreach $r (@root_directories) {
+ foreach my $r (@root_directories) {
if (-d "$r/$d") {
return "$r/$d";
}
local $_;
open(MIME, "$root_directory/mime.types");
while(<MIME>) {
- local $cmt;
+ my $cmt;
s/\r|\n//g;
if (s/#\s*(.*)$//g) {
$cmt = $1;
}
- local ($type, @exts) = split(/\s+/);
+ my ($type, @exts) = split(/\s+/);
if ($type) {
push(@list_mime_types_cache, { 'type' => $type,
'exts' => \@exts,
sub guess_mime_type
{
if ($_[0] =~ /\.([A-Za-z0-9\-]+)$/) {
- local $ext = $1;
- local ($t, $e);
- foreach $t (&list_mime_types()) {
- foreach $e (@{$t->{'exts'}}) {
+ my $ext = $1;
+ foreach my $t (&list_mime_types()) {
+ foreach my $e (@{$t->{'exts'}}) {
return $t->{'type'} if (lc($e) eq lc($ext));
}
}
# Just getting a temp file
if (!defined($main::open_tempfiles{$_[0]})) {
$_[0] =~ /^(.*)\/(.*)$/ || return $_[0];
- local $dir = $1 || "/";
- local $tmp = "$dir/$2.webmintmp.$$";
+ my $dir = $1 || "/";
+ my $tmp = "$dir/$2.webmintmp.$$";
$main::open_tempfiles{$_[0]} = $tmp;
push(@main::temporary_files, $tmp);
}
}
else {
# Actually opening
- local ($fh, $file, $noerror, $notemp, $safe) = @_;
- local %gaccess = &get_module_acl(undef, "");
+ my ($fh, $file, $noerror, $notemp, $safe) = @_;
+ my %gaccess = &get_module_acl(undef, "");
my $db = $gconfig{'debug_what_write'};
if ($file =~ /\r|\n|\0/) {
if ($noerror) { return 0; }
if ($noerror) { return 0; }
else { &error("Cannot write to directory $file"); }
}
- local $tmp = &open_tempfile($file);
- local $ex = open($fh, ">$tmp");
+ my $tmp = &open_tempfile($file);
+ my $ex = open($fh, ">$tmp");
if (!$ex && $! =~ /permission/i) {
# Could not open temp file .. try opening actual file
# instead directly
$file = $1;
$file = &translate_filename($file);
my @old_attributes = &get_clear_file_attributes($file);
- local $ex = open($fh, ">$file");
+ my $ex = open($fh, ">$file");
&reset_file_attributes($file, \@old_attributes);
$main::open_temphandles{$fh} = $file;
if (!$ex && !$noerror) {
$file = $1;
$file = &translate_filename($file);
my @old_attributes = &get_clear_file_attributes($file);
- local $ex = open($fh, ">>$file");
+ my $ex = open($fh, ">>$file");
&reset_file_attributes($file, \@old_attributes);
$main::open_temphandles{$fh} = $file;
if (!$ex && !$noerror) {
return open($fh, $file);
}
elsif ($file eq ">" || $file eq ">>") {
- local ($package, $filename, $line) = caller;
+ my ($package, $filename, $line) = caller;
if ($noerror) { return 0; }
else { &error("Missing file to open at ${package}::${filename} line $line"); }
}
else {
- # XXX append / update support?
- local ($package, $filename, $line) = caller;
+ my ($package, $filename, $line) = caller;
&error("Unsupported file or mode $file at ${package}::${filename} line $line");
}
}
=cut
sub close_tempfile
{
-local $file;
+my $file;
if (defined($file = $main::open_temphandles{$_[0]})) {
# Closing a handle
close($_[0]) || &error(&text("efileclose", $file, $!));
elsif (defined($main::open_tempfiles{$_[0]})) {
# Closing a file
&webmin_debug_log("CLOSE", $_[0]) if ($gconfig{'debug_what_write'});
- local @st = stat($_[0]);
+ my @st = stat($_[0]);
if (&is_selinux_enabled() && &has_command("chcon")) {
# Set original security context
system("chcon --reference=".quotemeta($_[0]).
=cut
sub print_tempfile
{
-local ($fh, @args) = @_;
+my ($fh, @args) = @_;
(print $fh @args) || &error(&text("efilewrite",
$main::open_temphandles{$fh} || $fh, $!));
}
sub is_selinux_enabled
{
if (!defined($main::selinux_enabled_cache)) {
- local %seconfig;
+ my %seconfig;
if ($gconfig{'os_type'} !~ /-linux$/) {
# Not on linux, so no way
$main::selinux_enabled_cache = 0;
=cut
sub reset_file_attributes
{
-local ($file, $old_attributes) = @_;
+my ($file, $old_attributes) = @_;
if (&indexof("i", @$old_attributes) >= 0) {
my $err = &backquote_logged(
"chattr +i ".quotemeta($file)." 2>&1");
=cut
sub cleanup_tempnames
{
-local $t;
-foreach $t (@main::temporary_files) {
+foreach my $t (@main::temporary_files) {
&unlink_file($t);
}
@main::temporary_files = ( );
=cut
sub open_lock_tempfile
{
-local $file = @_ == 1 ? $_[0] : $_[1];
+my $file = @_ == 1 ? $_[0] : $_[1];
$file =~ s/^[^\/]*//;
if ($file =~ /^\//) {
$main::open_templocks{$file} = &lock_file($file);
# Exiting from initial process
&cleanup_tempnames();
if ($gconfig{'debug_what_start'} && $main::debug_log_start_time &&
- $main::debug_log_start_module eq $module_name) {
- local $len = time() - $main::debug_log_start_time;
+ $main::debug_log_start_module eq &get_module_name()) {
+ my $len = time() - $main::debug_log_start_time;
&webmin_debug_log("STOP", "runtime=$len");
$main::debug_log_start_time = 0;
}
if (!$ENV{'SCRIPT_NAME'} &&
- $main::initial_module_name eq $module_name) {
+ $main::initial_module_name eq &get_module_name()) {
# In a command-line script - call the real exit, so that the
# exit status gets properly propogated. In some cases this
# was not happening.
=cut
sub get_rbac_module_acl
{
-local ($user, $mod) = @_;
+my ($user, $mod) = @_;
eval "use Authen::SolarisRBAC";
return undef if ($@);
-local %rv;
-local $foundany = 0;
+my %rv;
+my $foundany = 0;
if (Authen::SolarisRBAC::chkauth("webmin.$mod.admin", $user)) {
# Automagic webmin.modulename.admin authorization exists .. allow access
$foundany = 1;
while(<RBAC>) {
s/\r|\n//g;
s/#.*$//;
- local ($auths, $acls) = split(/\s+/, $_);
- local @auths = split(/,/, $auths);
+ my ($auths, $acls) = split(/\s+/, $_);
+ my @auths = split(/,/, $auths);
next if (!$auths);
- local ($merge) = ($acls =~ s/^\+//);
- local $a;
- local $gotall = 1;
+ my ($merge) = ($acls =~ s/^\+//);
+ my $gotall = 1;
if ($auths eq "*") {
# These ACLs apply to all RBAC users.
# Only if there is some that match a specific authorization
}
else {
# Check each of the RBAC authorizations
- foreach $a (@auths) {
+ foreach my $a (@auths) {
if (!Authen::SolarisRBAC::chkauth($a, $user)) {
$gotall = 0;
last;
if ($gotall) {
# Found an RBAC authorization - return the ACLs
return "*" if ($acls eq "*");
- local %acl = map { split(/=/, $_, 2) }
- split(/,/, $acls);
+ my %acl = map { split(/=/, $_, 2) } split(/,/, $acls);
if ($merge) {
# Just add to current set
- foreach $a (keys %acl) {
+ foreach my $a (keys %acl) {
$rv{$a} = $acl{$a};
}
}
Returns 1 if some user should use RBAC to get permissions for a module
=cut
-sub use_rbac_module_acl(user, module)
+sub use_rbac_module_acl
{
-local $u = defined($_[0]) ? $_[0] : $base_remote_user;
-local $m = defined($_[1]) ? $_[1] : $module_name;
+my $u = defined($_[0]) ? $_[0] : $base_remote_user;
+my $m = defined($_[1]) ? $_[1] : &get_module_name();
return 1 if ($gconfig{'rbacdeny_'.$u}); # RBAC forced for user
-local %access = &get_module_acl($u, $m, 1);
+my %access = &get_module_acl($u, $m, 1);
return $access{'rbac'} ? 1 : 0;
}
=cut
sub execute_command
{
-local ($cmd, $stdin, $stdout, $stderr, $trans, $safe) = @_;
+my ($cmd, $stdin, $stdout, $stderr, $trans, $safe) = @_;
if (&is_readonly_mode() && !$safe) {
print STDERR "Vetoing command $_[0]\n";
$? = 0;
return 0;
}
-local $cmd = &translate_command($cmd);
+my $cmd = &translate_command($cmd);
# Use ` operator where possible
if (!$stdin && ref($stdout) && !$stderr) {
pipe(EXECSTDINr, EXECSTDINw);
pipe(EXECSTDOUTr, EXECSTDOUTw);
pipe(EXECSTDERRr, EXECSTDERRw);
-local $pid;
+my $pid;
if (!($pid = fork())) {
untie(*STDIN);
untie(*STDOUT);
close(EXECSTDOUTr);
close(EXECSTDERRr);
- local $fullcmd = "($cmd)";
+ my $fullcmd = "($cmd)";
if ($stdin && !ref($stdin)) {
$fullcmd .= " <$stdin";
}
=cut
sub open_readfile
{
-local ($fh, $file) = @_;
-local $realfile = &translate_filename($file);
+my ($fh, $file) = @_;
+my $realfile = &translate_filename($file);
&webmin_debug_log('READ', $file) if ($gconfig{'debug_what_read'});
return open($fh, "<".$realfile);
}
=cut
sub open_execute_command
{
-local ($fh, $cmd, $mode, $safe) = @_;
-local $realcmd = &translate_command($cmd);
+my ($fh, $cmd, $mode, $safe) = @_;
+my $realcmd = &translate_command($cmd);
if (&is_readonly_mode() && !$safe) {
# Don't actually run it
print STDERR "vetoing command $cmd\n";
=cut
sub translate_filename
{
-local $realfile = $_[0];
-local @funcs = grep { $_->[0] eq $module_name ||
- !defined($_->[0]) } @main::filename_callbacks;
-local $f;
-foreach $f (@funcs) {
- local $func = $f->[1];
+my ($realfile) = @_;
+my @funcs = grep { $_->[0] eq &get_module_name() ||
+ !defined($_->[0]) } @main::filename_callbacks;
+foreach my $f (@funcs) {
+ my $func = $f->[1];
$realfile = &$func($realfile, @{$f->[2]});
}
return $realfile;
=cut
sub translate_command
{
-local $realcmd = $_[0];
-local @funcs = grep { $_->[0] eq $module_name ||
- !defined($_->[0]) } @main::command_callbacks;
-local $f;
-foreach $f (@funcs) {
- local $func = $f->[1];
+my ($realcmd) = @_;
+my @funcs = grep { $_->[0] eq &get_module_name() ||
+ !defined($_->[0]) } @main::command_callbacks;
+foreach my $f (@funcs) {
+ my $func = $f->[1];
$realcmd = &$func($realcmd, @{$f->[2]});
}
return $realcmd;
=cut
sub register_filename_callback
{
-local ($mod, $func, $args) = @_;
+my ($mod, $func, $args) = @_;
push(@main::filename_callbacks, [ $mod, $func, $args ]);
}
=cut
sub register_command_callback
{
-local ($mod, $func, $args) = @_;
+my ($mod, $func, $args) = @_;
push(@main::command_callbacks, [ $mod, $func, $args ]);
}
=cut
sub capture_function_output
{
-local ($func, @args) = @_;
+my ($func, @args) = @_;
socketpair(SOCKET2, SOCKET1, AF_UNIX, SOCK_STREAM, PF_UNSPEC);
-local $old = select(SOCKET1);
-local @rv = &$func(@args);
+my $old = select(SOCKET1);
+my @rv = &$func(@args);
select($old);
close(SOCKET1);
-local $out;
+my $out;
local $_;
while(<SOCKET2>) {
$out .= $_;
{
return &theme_modules_chooser_button(@_)
if (defined(&theme_modules_chooser_button));
-local $form = defined($_[2]) ? $_[2] : 0;
-local $w = $_[1] ? 700 : 500;
-local $h = 200;
+my $form = defined($_[2]) ? $_[2] : 0;
+my $w = $_[1] ? 700 : 500;
+my $h = 200;
if ($_[1] && $gconfig{'db_sizemodules'}) {
($w, $h) = split(/x/, $gconfig{'db_sizemodules'});
}
sub substitute_template
{
# Add some extra fixed parameters to the hash
-local %hash = %{$_[1]};
+my %hash = %{$_[1]};
$hash{'hostname'} = &get_system_hostname();
$hash{'webmin_config'} = $config_directory;
$hash{'webmin_etc'} = $config_directory;
-$hash{'module_config'} = $module_config_directory;
+$hash{'module_config'} = &get_module_variable('$module_config_directory');
$hash{'webmin_var'} = $var_directory;
# Add time-based parameters, for use in DNS
$hash{'current_time'} = time();
-local @tm = localtime($hash{'current_time'});
+my @tm = localtime($hash{'current_time'});
$hash{'current_year'} = $tm[5]+1900;
$hash{'current_month'} = sprintf("%2.2d", $tm[4]+1);
$hash{'current_day'} = sprintf("%2.2d", $tm[3]);
$hash{'current_second'} = sprintf("%2.2d", $tm[0]);
# Actually do the substition
-local $rv = $_[0];
-local $s;
-foreach $s (keys %hash) {
+my $rv = $_[0];
+foreach my $s (keys %hash) {
next if ($s eq ''); # Prevent just $ from being subbed
- local $us = uc($s);
- local $sv = $hash{$s};
+ my $us = uc($s);
+ my $sv = $hash{$s};
$rv =~ s/\$\{\Q$us\E\}/$sv/g;
$rv =~ s/\$\Q$us\E/$sv/g;
if ($sv) {
{
return 0 if ($gconfig{'os_type'} ne 'solaris' ||
$gconfig{'os_version'} < 10);
-local $zn = `zonename 2>$null_file`;
+my $zn = `zonename 2>$null_file`;
chop($zn);
return $zn && $zn ne "global";
}
sub running_in_vserver
{
return 0 if ($gconfig{'os_type'} !~ /^\*-linux$/);
-local $vserver;
+my $vserver;
+local $_;
open(MTAB, "/etc/mtab");
while(<MTAB>) {
- local ($dev, $mp) = split(/\s+/, $_);
+ my ($dev, $mp) = split(/\s+/, $_);
if ($mp eq "/" && $dev =~ /^\/dev\/hdv/) {
$vserver = 1;
last;
sub running_in_xen
{
return 0 if (!-r "/proc/xen/capabilities");
-local $cap = &read_file_contents("/proc/xen/capabilities");
+my $cap = &read_file_contents("/proc/xen/capabilities");
return $cap =~ /control_d/ ? 0 : 1;
}
=cut
sub list_categories
{
-local (%cats, %catnames);
+my (%cats, %catnames);
&read_file("$config_directory/webmin.catnames", \%catnames);
foreach my $o (@lang_order_list) {
&read_file("$config_directory/webmin.catnames.$o", \%catnames);
}
-local $m;
-foreach $m (@{$_[0]}) {
- local $c = $m->{'category'};
+foreach my $m (@{$_[0]}) {
+ my $c = $m->{'category'};
next if ($cats{$c});
if (defined($catnames{$c})) {
$cats{$c} = $catnames{$c};
}
else {
# try to get category name from module ..
- local %mtext = &load_language($m->{'dir'});
+ my %mtext = &load_language($m->{'dir'});
if ($mtext{"category_$c"}) {
$cats{$c} = $mtext{"category_$c"};
}
sub is_readonly_mode
{
if (!defined($main::readonly_mode_cache)) {
- local %gaccess = &get_module_acl(undef, "");
+ my %gaccess = &get_module_acl(undef, "");
$main::readonly_mode_cache = $gaccess{'readonly'} ? 1 : 0;
}
return $main::readonly_mode_cache;
=cut
sub command_as_user
{
-local ($user, $env, $cmd, @args) = @_;
+my ($user, $env, $cmd, @args) = @_;
if ($gconfig{'os_type'} =~ /-linux$/) {
# In case user doesn't have a valid shell
- local @uinfo = getpwnam($user);
+ my @uinfo = getpwnam($user);
if ($uinfo[8] ne "/bin/sh" && $uinfo[8] !~ /\/bash$/) {
$shellarg = " -s /bin/sh";
}
}
-local $rv = "su".($env ? " -" : "").$shellarg.
- " ".quotemeta($user)." -c ".quotemeta(join(" ", $cmd, @args));
+my $rv = "su".($env ? " -" : "").$shellarg.
+ " ".quotemeta($user)." -c ".quotemeta(join(" ", $cmd, @args));
return $rv;
}
=cut
sub list_osdn_mirrors
{
-local ($project, $file) = @_;
-local ($page, $error, @rv);
+my ($project, $file) = @_;
+my ($page, $error, @rv);
&http_download($osdn_download_host, $osdn_download_port,
"/project/mirror_picker.php?groupname=".&urlize($project).
"&filename=".&urlize($file),
if (!@rv) {
# None found! Try some known mirrors
foreach my $m ("superb-east", "superb-west", "osdn") {
- local $url = "http://$m.dl.sourceforge.net".
+ my $url = "http://$m.dl.sourceforge.net".
"/sourceforge/$project/$file";
- local ($host, $port, $page, $ssl) = &parse_http_url($url);
- local $h = &make_http_connection(
+ my ($host, $port, $page, $ssl) = &parse_http_url($url);
+ my $h = &make_http_connection(
$host, $port, $ssl, "HEAD", $page);
next if (!ref($h));
=cut
sub convert_osdn_url
{
-local ($url) = @_;
+my ($url) = @_;
if ($url =~ /^http:\/\/[^\.]+.dl.sourceforge.net\/sourceforge\/([^\/]+)\/(.*)$/ ||
$url =~ /^http:\/\/prdownloads.sourceforge.net\/([^\/]+)\/(.*)$/) {
# Find best site
- local ($project, $file) = ($1, $2);
- local @mirrors = &list_osdn_mirrors($project, $file);
- local $site;
- local $pref = $gconfig{'osdn_mirror'} || "unc";
- ($site) = grep { $_->{'mirror'} eq $pref } @mirrors;
+ my ($project, $file) = ($1, $2);
+ my @mirrors = &list_osdn_mirrors($project, $file);
+ my $pref = $gconfig{'osdn_mirror'} || "unc";
+ my ($site) = grep { $_->{'mirror'} eq $pref } @mirrors;
$site ||= $mirrors[0];
return wantarray ? ( $site->{'url'}, $site->{'default'} )
: $site->{'url'};
=cut
sub get_current_dir
{
-local $out;
+my $out;
if ($gconfig{'os_type'} eq 'windows') {
# Use cd command
$out = `cd`;
=cut
sub quote_path
{
-local ($path) = @_;
+my ($path) = @_;
if ($gconfig{'os_type'} eq 'windows' || $path =~ /^[a-z]:/i) {
# Windows only supports "" style quoting
return "\"$path\"";
sub get_windows_root
{
if ($ENV{'SystemRoot'}) {
- local $rv = $ENV{'SystemRoot'};
+ my $rv = $ENV{'SystemRoot'};
$rv =~ s/\\/\//g;
return $rv;
}
{
&open_readfile(FILE, $_[0]) || return undef;
local $/ = undef;
-local $rv = <FILE>;
+my $rv = <FILE>;
close(FILE);
return $rv;
}
=cut
sub unix_crypt
{
-local ($pass, $salt) = @_;
+my ($pass, $salt) = @_;
return "" if (!$salt); # same as real crypt
-local $rv = eval "crypt(\$pass, \$salt)";
-local $err = $@;
+my $rv = eval "crypt(\$pass, \$salt)";
+my $err = $@;
return $rv if ($rv && !$@);
eval "use Crypt::UnixCrypt";
if (!$@) {
=cut
sub split_quoted_string
{
-local $str = $_[0];
-local @rv;
+my ($str) = @_;
+my @rv;
while($str =~ /^"([^"]*)"\s*([\000-\377]*)$/ ||
$str =~ /^'([^']*)'\s*([\000-\377]*)$/ ||
$str =~ /^(\S+)\s*([\000-\377]*)$/) {
=cut
sub write_to_http_cache
{
-local ($url, $file) = @_;
+my ($url, $file) = @_;
return 0 if (!$gconfig{'cache_size'});
# Don't cache downloads that look dynamic
# Check if the current module should do caching
if ($gconfig{'cache_mods'} =~ /^\!(.*)$/) {
# Caching all except some modules
- local @mods = split(/\s+/, $1);
- return 0 if (&indexof($module_name, @mods) != -1);
+ my @mods = split(/\s+/, $1);
+ return 0 if (&indexof(&get_module_name(), @mods) != -1);
}
elsif ($gconfig{'cache_mods'}) {
# Only caching some modules
- local @mods = split(/\s+/, $gconfig{'cache_mods'});
- return 0 if (&indexof($module_name, @mods) == -1);
+ my @mods = split(/\s+/, $gconfig{'cache_mods'});
+ return 0 if (&indexof(&get_module_name(), @mods) == -1);
}
# Work out the size
-local $size;
+my $size;
if (ref($file)) {
$size = length($$file);
}
else {
- local @st = stat($file);
+ my @st = stat($file);
$size = $st[7];
}
# Bigger than the whole cache - so don't save it
return 0;
}
-local $cfile = $url;
+my $cfile = $url;
$cfile =~ s/\//_/g;
$cfile = "$main::http_cache_directory/$cfile";
# See how much we have cached currently, clearing old files
-local $total = 0;
+my $total = 0;
mkdir($main::http_cache_directory, 0700) if (!-d $main::http_cache_directory);
opendir(CACHEDIR, $main::http_cache_directory);
foreach my $f (readdir(CACHEDIR)) {
next if ($f eq "." || $f eq "..");
- local $path = "$main::http_cache_directory/$f";
- local @st = stat($path);
+ my $path = "$main::http_cache_directory/$f";
+ my @st = stat($path);
if ($gconfig{'cache_days'} &&
time()-$st[9] > $gconfig{'cache_days'}*24*60*60) {
# This file is too old .. trash it
&close_tempfile(CACHEFILE);
}
else {
- local ($ok, $err) = ©_source_dest($file, $cfile);
+ my ($ok, $err) = ©_source_dest($file, $cfile);
}
return 1;
=cut
sub check_in_http_cache
{
-local ($url) = @_;
+my ($url) = @_;
return undef if (!$gconfig{'cache_size'});
# Check if the current module should do caching
if ($gconfig{'cache_mods'} =~ /^\!(.*)$/) {
# Caching all except some modules
- local @mods = split(/\s+/, $1);
- return 0 if (&indexof($module_name, @mods) != -1);
+ my @mods = split(/\s+/, $1);
+ return 0 if (&indexof(&get_module_name(), @mods) != -1);
}
elsif ($gconfig{'cache_mods'}) {
# Only caching some modules
- local @mods = split(/\s+/, $gconfig{'cache_mods'});
- return 0 if (&indexof($module_name, @mods) == -1);
+ my @mods = split(/\s+/, $gconfig{'cache_mods'});
+ return 0 if (&indexof(&get_module_name(), @mods) == -1);
}
-local $cfile = $url;
+my $cfile = $url;
$cfile =~ s/\//_/g;
$cfile = "$main::http_cache_directory/$cfile";
-local @st = stat($cfile);
+my @st = stat($cfile);
return undef if (!@st || !$st[7]);
if ($gconfig{'cache_days'} && time()-$st[9] > $gconfig{'cache_days'}*24*60*60) {
# Too old!
return $ENV{'MOBILE_DEVICE'} ? 0 : 1;
}
+# get_module_name()
+# Returns the name of the Webmin module that called this function
+sub get_module_name
+{
+return &get_module_variable('$module_name');
+}
+
+# get_module_variable(name, [ref])
+# Returns the value of some variable which is set in the caller's context, if
+# using the new WebminCore package.
+sub get_module_variable
+{
+my ($v, $wantref) = @_;
+if (__PACKAGE__ eq 'WebminCore') {
+ my ($vt, $vn) = split('', $v, 2);
+ my $callpkg;
+ for(my $i=0; ($callpkg) = caller($i); $i++) {
+ last if ($callpkg ne __PACKAGE__);
+ }
+ my $slash = $wantref ? "\\" : "";
+ return eval "${slash}${vt}${callpkg}::${vn}";
+ }
+return eval "$v";
+}
+
+# set_module_variable(name, value)
+# Sets some variable in the calling module's package
+sub set_module_variable
+{
+my ($v, $value) = @_;
+# XXX
+}
+
$done_web_lib_funcs = 1;
1;
projects / webmin.git / commitdiff