405 lines
9.7 KiB
Perl
405 lines
9.7 KiB
Perl
|
# STTA Rev. 1.3 Copyright (c) 2001-2004 Jes<65>s P<>rez Lorenzo --- license GNU GPL
|
|||
|
|
# stta: (@#) 1.31051043346- [2004_01_29_102036]
|
|||
|
|
# Lib Common
|
|||
|
|
# Just in case NO WEBMIN (web-lib.pl, etc.) are loaded ...
|
|||
|
|
# Some variables are needed and set here, will be reassigned later
|
|||
|
|
# Globals ...
|
|||
|
|
# Some functions are hooks
|
|||
|
|
# others are empty to avoid full Webmin code for line command execution
|
|||
|
|
|
|||
|
|
# Vital libraries
|
|||
|
|
use Socket;
|
|||
|
|
#use SelfLoader;
|
|||
|
|
|
|||
|
|
$stta_sid="";
|
|||
|
|
|
|||
|
|
# Read Config File
|
|||
|
|
sub initialize () {
|
|||
|
|
$no_out=$config{output_cgis};
|
|||
|
|
$scriptname=$tool_name;
|
|||
|
|
&read_file("$config_directory/config", \%gconfig);
|
|||
|
|
if ( $gconfig{lang} && $gconfig{lang} ne "" ) { $current_lang=$gconfig{lang} }
|
|||
|
|
&read_file("$config_directory/miniserv.conf", \%gconfig);
|
|||
|
|
$module_name="stta";
|
|||
|
|
$root_directory=$gconfig{root};
|
|||
|
|
}
|
|||
|
|
sub start_debug () {
|
|||
|
|
if ( $debug gt 0 ) {
|
|||
|
|
if ( !$DebugFile ) { $DebugFile=$config{stta_debugname}.$tool_name.".log";}
|
|||
|
|
open(DebugLog, ">>$DebugFile");
|
|||
|
|
if ( !DebugLog) { $debug=0 };
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# Read Module Text
|
|||
|
|
# load_language([module])
|
|||
|
|
# Returns a hashtable mapping text codes to strings in the appropriate language
|
|||
|
|
sub load_language
|
|||
|
|
{
|
|||
|
|
local %text;
|
|||
|
|
if ($module_name) {
|
|||
|
|
local $mod = $_[0] ? "../$_[0]" : ".";
|
|||
|
|
&read_file("../lang/$default_lang", \%text);
|
|||
|
|
&read_file("../lang/$current_lang", \%text);
|
|||
|
|
&read_file("$mod/lang/$default_lang", \%text);
|
|||
|
|
&read_file("$mod/lang/$current_lang", \%text);
|
|||
|
|
}
|
|||
|
|
else {
|
|||
|
|
&read_file("lang/$default_lang", \%text);
|
|||
|
|
&read_file("lang/$current_lang", \%text);
|
|||
|
|
if ($_[0]) {
|
|||
|
|
&read_file("$_[0]/lang/$default_lang", \%text);
|
|||
|
|
&read_file("$_[0]/lang/$current_lang", \%text);
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
foreach $k (keys %text) {
|
|||
|
|
$text{$k} =~ s/\$([A-Za-z0-9\.\-\_]+)/text_subs($1,\%text)/ge;
|
|||
|
|
}
|
|||
|
|
return %text;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
sub text_subs
|
|||
|
|
{
|
|||
|
|
local $t = $_[1]->{$_[0]};
|
|||
|
|
return defined($t) ? $t : '$'.$_[0];
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# text(message, [substitute]+)
|
|||
|
|
sub text
|
|||
|
|
{
|
|||
|
|
local $rv = $text{$_[0]};
|
|||
|
|
local $i;
|
|||
|
|
for($i=1; $i<@_; $i++) {
|
|||
|
|
$rv =~ s/\$$i/$_[$i]/g;
|
|||
|
|
}
|
|||
|
|
return $rv;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# read_file(file, &assoc, [&order], [lowercase])
|
|||
|
|
# Fill an associative array with name=value pairs from a file
|
|||
|
|
sub read_file
|
|||
|
|
{
|
|||
|
|
open(ARFILE, $_[0]) || return 0;
|
|||
|
|
while(<ARFILE>) {
|
|||
|
|
s/\r|\n//g;
|
|||
|
|
if (!/^#/ && /^([^=]+)=(.*)$/) {
|
|||
|
|
$_[1]->{$_[3] ? lc($1) : $1} = $2;
|
|||
|
|
push(@{$_[2]}, $1) if ($_[2]);
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
close(ARFILE);
|
|||
|
|
return 1;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# write_file(file, array)
|
|||
|
|
# Write out the contents of an associative array as name=value lines
|
|||
|
|
sub write_file
|
|||
|
|
{
|
|||
|
|
local(%old, @order);
|
|||
|
|
&read_file($_[0], \%old, \@order);
|
|||
|
|
open(ARFILE, ">$_[0]");
|
|||
|
|
foreach $k (@order) {
|
|||
|
|
print ARFILE $k,"=",$_[1]->{$k},"\n" if (exists($_[1]->{$k}));
|
|||
|
|
}
|
|||
|
|
foreach $k (keys %{$_[1]}) {
|
|||
|
|
print ARFILE $k,"=",$_[1]->{$k},"\n" if (!exists($old{$k}));
|
|||
|
|
}
|
|||
|
|
close(ARFILE);
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
sub lock_file
|
|||
|
|
{
|
|||
|
|
return 1;
|
|||
|
|
}
|
|||
|
|
sub unlock_file
|
|||
|
|
{
|
|||
|
|
return 1;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
|
|||
|
|
# get_module_acl([user], [module])
|
|||
|
|
# Returns an array containing access control options for the given user
|
|||
|
|
sub get_module_acl
|
|||
|
|
{
|
|||
|
|
local %rv;
|
|||
|
|
local $u = defined($_[0]) ? $_[0] : $base_remote_user;
|
|||
|
|
local $m = defined($_[1]) ? $_[1] : $module_name;
|
|||
|
|
&read_file($module_name ? "../$m/defaultacl" : "./$m/defaultacl", \%rv);
|
|||
|
|
if ($gconfig{"risk_$u"} && $m) {
|
|||
|
|
local $rf = $gconfig{"risk_$u"}.'.risk';
|
|||
|
|
&read_file($module_name ? "../$m/$rf" : "./$m/$rf", \%rv);
|
|||
|
|
|
|||
|
|
local $sf = $gconfig{"skill_$u"}.'.skill';
|
|||
|
|
&read_file($module_name ? "../$m/$sf" : "./$m/$sf", \%rv);
|
|||
|
|
}
|
|||
|
|
else {
|
|||
|
|
&read_file("$config_directory/$m/$u.acl", \%rv);
|
|||
|
|
}
|
|||
|
|
return %rv;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# webmin_log(action, type, object, ¶ms, [module])
|
|||
|
|
# Log some action taken by a user
|
|||
|
|
sub webmin_log
|
|||
|
|
{
|
|||
|
|
return if (!$config{'stta_logname'});
|
|||
|
|
local $m = $_[4] ? $_[4] : $module_name;
|
|||
|
|
#local $m_logfile=$config{'stta_logname'}.$tool_name.".log";
|
|||
|
|
local $m_logfile="/var/webmin/webmin.log";
|
|||
|
|
|
|||
|
|
#$m="$tool_name ($m)";
|
|||
|
|
$m="tarantella";
|
|||
|
|
# 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;
|
|||
|
|
$stta_sid=$id;
|
|||
|
|
$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\"",
|
|||
|
|
$id, $tm[3], $text{"smonth_".($tm[4]+1)}, $tm[5]+1900,
|
|||
|
|
$tm[2], $tm[1], $tm[0],
|
|||
|
|
$remote_user, $main::session_id ? $main::session_id : '-',
|
|||
|
|
$ENV{'REMOTE_HOST'},
|
|||
|
|
$m, $script_name,
|
|||
|
|
$_[0], $_[1] ne '' ? $_[1] : '-', $_[2] ne '' ? $_[2] : '-';
|
|||
|
|
foreach $k (sort { $a cmp $b } keys %{$_[3]}) {
|
|||
|
|
local $v = $_[3]->{$k};
|
|||
|
|
if ($v eq '') {
|
|||
|
|
$line .= " $k=''";
|
|||
|
|
}
|
|||
|
|
elsif (ref($v) eq 'ARRAY') {
|
|||
|
|
foreach $vv (@$v) {
|
|||
|
|
next if (ref($vv));
|
|||
|
|
$vv =~ s/(['"\\\r\n\t\%])/sprintf("%%%2.2X",ord($1))/ge;
|
|||
|
|
$line .= " $k='$vv'";
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
elsif (!ref($v)) {
|
|||
|
|
foreach $vv (split(/\0/, $v)) {
|
|||
|
|
$vv =~ s/(['"\\\r\n\t\%])/sprintf("%%%2.2X",ord($1))/ge;
|
|||
|
|
$line .= " $k='$vv'";
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
if ( $debug gt 0 ) {
|
|||
|
|
print DebugLog $line,"\n";
|
|||
|
|
} else {
|
|||
|
|
open(WEBMINLOG, ">>$m_logfile");
|
|||
|
|
print WEBMINLOG $line,"\n";
|
|||
|
|
close(WEBMINLOG);
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# additional_log(type, object, data)
|
|||
|
|
# Records additional log data for an upcoming call to webmin_log, such
|
|||
|
|
# as command that was run or SQL that was executed.
|
|||
|
|
sub additional_log
|
|||
|
|
{
|
|||
|
|
return if (!$config{'stta_logname'});
|
|||
|
|
webmin_log($_[0],$_[1],$_[2],$_[3],$_[4]);
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
sub endclose_debug
|
|||
|
|
{
|
|||
|
|
print DebugLog "----------------------------------------------\n";
|
|||
|
|
close (DebugLog);
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# error([message]+)
|
|||
|
|
# Display an error message and exit. The variable $whatfailed must be set
|
|||
|
|
# to the name of the operation that failed.
|
|||
|
|
sub error
|
|||
|
|
{
|
|||
|
|
if ( $debug gt 0 ) {
|
|||
|
|
print DebugLog "$text{'error'}: ";
|
|||
|
|
print DebugLog ($whatfailed ? "$whatfailed : " : ""),@_,"\n";
|
|||
|
|
}
|
|||
|
|
if ( $debug gt 0 ) { &endclose_debug(); }
|
|||
|
|
exit;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
sub SrvError
|
|||
|
|
{
|
|||
|
|
print DebugLog @_,"\n";
|
|||
|
|
if ( $debug gt 0 ) { &endclose_debug(); }
|
|||
|
|
exit;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# error_setup(message)
|
|||
|
|
# Register a message to be prepended to all error strings
|
|||
|
|
sub error_setup
|
|||
|
|
{
|
|||
|
|
$whatfailed = $_[0];
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# unique
|
|||
|
|
# Returns the unique elements of some array
|
|||
|
|
sub unique
|
|||
|
|
{
|
|||
|
|
local(%found, @rv, $e);
|
|||
|
|
foreach $e (@_) {
|
|||
|
|
if (!$found{$e}++) { push(@rv, $e); }
|
|||
|
|
}
|
|||
|
|
return @rv;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# seed_random()
|
|||
|
|
# Seeds the random number generator, if needed
|
|||
|
|
sub seed_random
|
|||
|
|
{
|
|||
|
|
if (!$main::done_seed_random) {
|
|||
|
|
if (open(RANDOM, "/dev/urandom")) {
|
|||
|
|
local $buf;
|
|||
|
|
read(RANDOM, $buf, 4);
|
|||
|
|
close(RANDOM);
|
|||
|
|
srand(time() ^ $$ ^ $buf);
|
|||
|
|
}
|
|||
|
|
else {
|
|||
|
|
srand(time() ^ $$);
|
|||
|
|
}
|
|||
|
|
$main::done_seed_random = 1;
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# tempname([filename])
|
|||
|
|
# Returns a mostly random temporary file name
|
|||
|
|
sub tempname
|
|||
|
|
{
|
|||
|
|
local $tmp_dir = "/tmp/.webmin";
|
|||
|
|
while(1) {
|
|||
|
|
local @st = lstat($tmp_dir);
|
|||
|
|
last if (!$st[4] && !$st[5] && $st[2] & 0x4000 &&
|
|||
|
|
($st[2] & 0777) == 0755);
|
|||
|
|
if (@st) {
|
|||
|
|
unlink($tmp_dir) || rmdir($tmp_dir) ||
|
|||
|
|
system("/bin/rm -rf \"$tmp_dir\"");
|
|||
|
|
}
|
|||
|
|
mkdir($tmp_dir, 0755) || next;
|
|||
|
|
chown(0, 0, $tmp_dir);
|
|||
|
|
chmod(0755, $tmp_dir);
|
|||
|
|
}
|
|||
|
|
if (defined($_[0]) && $_[0] !~ /\.\./) {
|
|||
|
|
return "$tmp_dir/$_[0]";
|
|||
|
|
}
|
|||
|
|
else {
|
|||
|
|
$main::tempfilecount++;
|
|||
|
|
&seed_random();
|
|||
|
|
return $tmp_dir."/".int(rand(1000000))."_".
|
|||
|
|
$main::tempfilecount."_".$scriptname;
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
sub html_errshow
|
|||
|
|
{
|
|||
|
|
local $where_err = $_[0];
|
|||
|
|
|
|||
|
|
if ( !$DebugFile ) {
|
|||
|
|
print DebugLog "$wher_err ($err) $stta_sid:".eval("\$text{'msgerr_$err'}")."\n";
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# foreign_call(module, function, [arg]*)
|
|||
|
|
# Call a function in another module
|
|||
|
|
sub foreign_call
|
|||
|
|
{
|
|||
|
|
local $pkg = $_[0] ? $_[0] : "global";
|
|||
|
|
$pkg =~ s/[^A-Za-z0-9]/_/g;
|
|||
|
|
local @args = @_[2 .. @_-1];
|
|||
|
|
$main::foreign_args = \@args;
|
|||
|
|
local @rv = eval <<EOF;
|
|||
|
|
#package $pkg;
|
|||
|
|
&$_[1](\@{\$main::foreign_args});
|
|||
|
|
EOF
|
|||
|
|
if ($@) { &error("$_[0]::$_[1] failed : $@"); }
|
|||
|
|
return wantarray ? @rv : $rv[0];
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# safe_process_exec(command, uid, gid, handle, input, fixtags, bsmode)
|
|||
|
|
# Executes the given command as the given user/group and writes all output
|
|||
|
|
# to the given file handle. Finishes when there is no more output or the
|
|||
|
|
# process stops running. Returns the number of bytes read.
|
|||
|
|
sub safe_process_exec
|
|||
|
|
{
|
|||
|
|
# setup pipes and fork the process
|
|||
|
|
local $chld = $SIG{'CHLD'};
|
|||
|
|
pipe(OUTr, OUTw);
|
|||
|
|
pipe(INr, INw);
|
|||
|
|
local $pid = fork();
|
|||
|
|
if (!$pid) {
|
|||
|
|
#setsid();
|
|||
|
|
untie(*STDIN);
|
|||
|
|
untie(*STDOUT);
|
|||
|
|
untie(*STDERR);
|
|||
|
|
open(STDIN, "<&INr");
|
|||
|
|
open(STDOUT, ">&OUTw");
|
|||
|
|
open(STDERR, ">&OUTw");
|
|||
|
|
$| = 1;
|
|||
|
|
close(OUTr); close(INw);
|
|||
|
|
|
|||
|
|
if ($_[1]) {
|
|||
|
|
if (defined($_[2])) {
|
|||
|
|
# switch to given UID and GID
|
|||
|
|
$( = $_[2]; $) = "$_[2] $_[2]";
|
|||
|
|
($>, $<) = ($_[1], $_[1]);
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# run the command
|
|||
|
|
exec("/bin/sh", "-c", $_[0]);
|
|||
|
|
# print "Exec failed : $!\n";
|
|||
|
|
exit 1;
|
|||
|
|
}
|
|||
|
|
close(OUTw); close(INr);
|
|||
|
|
# print "Exec $_[0]\n";
|
|||
|
|
|
|||
|
|
# Feed input (if any)
|
|||
|
|
print INw $_[4];
|
|||
|
|
close(INw);
|
|||
|
|
|
|||
|
|
# Read and show output
|
|||
|
|
local $fn = fileno(OUTr);
|
|||
|
|
local $got = 0;
|
|||
|
|
local $out = $_[3];
|
|||
|
|
local $line;
|
|||
|
|
while(1) {
|
|||
|
|
local ($rmask, $buf);
|
|||
|
|
vec($rmask, $fn, 1) = 1;
|
|||
|
|
local $sel = select($rmask, undef, undef, 1);
|
|||
|
|
if ($sel > 0 && vec($rmask, $fn, 1)) {
|
|||
|
|
# got something to read.. print it
|
|||
|
|
sysread(OUTr, $buf, 1024) || last;
|
|||
|
|
$got += length($buf);
|
|||
|
|
if ($_[5]) {
|
|||
|
|
$buf = &html_escape($buf);
|
|||
|
|
}
|
|||
|
|
if ($_[6]) {
|
|||
|
|
# Convert backspaces and returns and escapes
|
|||
|
|
$line .= $buf;
|
|||
|
|
while($line =~ s/^([^\n]*\n)//) {
|
|||
|
|
local $one = $1;
|
|||
|
|
while($one =~ s/.\010//) { }
|
|||
|
|
$out =~ s/\033[^m]+m//g;
|
|||
|
|
print $out $one;
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
else {
|
|||
|
|
print $out $buf;
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
elsif ($sel == 0) {
|
|||
|
|
# nothing to read. maybe the process is done, and a subprocess
|
|||
|
|
# is hanging things up
|
|||
|
|
last if (!kill(0, $pid));
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
close(OUTr);
|
|||
|
|
print $out $line;
|
|||
|
|
return $got;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
1; # Return true
|