ossp-pkg/tabea/tabea.cgi
1.38
#!/usr/opkg/bin/perl -w
##
## OSSP tabea - Web Configuration Editor
## Copyright (c) 2001-2002 The OSSP Project <http://www.ossp.org/>
## Copyright (c) 2001-2002 Cable & Wireless Deutschland <http://www.cw.com/de/>
##
## This file is part of OSSP tabea, a web configuration editor
## which can be found at http://www.ossp.org/pkg/tool/tabea/.
##
## Permission to use, copy, modify, and distribute this software for
## any purpose with or without fee is hereby granted, provided that
## the above copyright notice and this permission notice appear in all
## copies.
##
## THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
## SUCH DAMAGE.
##
## tabea.cgi: Tabea CGI (syntax: Perl)
##
require 5.000;
use strict;
use IO;
use CGI;
$|++;
my $cfgfile = "./tabea.cfg";
# establish CGI query object
my $cgi = new CGI;
# activate a general error handler
$SIG{__DIE__} = sub {
my ($err) = @_;
#$err =~ s|at\s+\S+\s+line\s+(\d+)|(line $1)|s;
$err =~ s|\n|<br>\n|sg;
print STDOUT $cgi->header(-expires => '+1s') .
"<title>Tabea :: ERROR</title>",
"<h1>Tabea :: ERROR</h1>\n" .
"<pre>$err</pre>\n";
exit(0);
};
# update cookies
my $cookies = [];
foreach my $param (qw(username)) { # FIXME!
if ($cgi->param($param) ne '' and ($cgi->param($param) ne $cgi->cookie($param))) {
push(@{$cookies}, $cgi->cookie(
-name => $param,
-value => $cgi->param($param),
-expires => '+1d',
-path => $cgi->url(-absolute => 1),
-secure => 0
));
}
if ($cgi->param($param) eq '' and $cgi->cookie($param) ne '') {
$cgi->param(-name => $param, -value => [$cgi->cookie($param)]);
}
}
# Read the configuration
my %cfghash = &read_config($cfgfile);
# Get HTML Header
my $MY = {};
$MY->{TEMPLATE} = '';
my $fh = new IO::File ("<".$cfghash{'BaseDir'} . $cfghash{'PageTemplate'}) || die;
$MY->{TEMPLATE} .= $_ while (<$fh>);
$fh->close();
# fetch parameters
my $dialog = $cgi->param("dialog") || "";
my $username = $cgi->param("username") || "";
my $password = $cgi->param("password") || "";
my $akt_user = $cgi->param("akt_user") || "";
my $old_password = $cgi->param("old_password") || "";
my $new1_password = $cgi->param("new1_password") || "";
my $new2_password = $cgi->param("new2_password") || "";
my $filename = $cgi->param("filename") || "";
my $headertext = "";
my $form = '';
for my $name (qw(admin cfgedit changepwd changer chpwd confr copy copyc copyt del d2user d3user \
duser edit logout mainw new newf newuser nuser run save view )) {
my $val = $cgi->param("dialog_$name") || "";
if ($val ne '') {
$form = $name;
}
}
NEXTFORM:
my $page = $cgi->startform( -method => "POST", -action => $cgi->url(-full => 1));
if ($form eq '') {
$page .= &login();
$headertext = "Login";
}
elsif ($form eq 'mainw') {
$page .= mainw();
$headertext = "Main";
}
elsif ($form eq 'edit') {
$page .= &edit($cgi->param('configslist'));
$headertext = "Edit";
}
elsif ($form eq 'save') {
$page .= &save($cgi->param('editfile'), $cgi->param('editwindow'));
$headertext = "Save";
}
elsif ($form eq 'view') {
$page .= &view($cgi->param('templatelist'));
$headertext = "View";
}
elsif ($form eq 'new') {
$page .= &new($cfghash{'BaseDir'} . $cfghash{'ConfigDir'}, $username);
$headertext = "New File";
}
elsif ($form eq 'newf') {
$page .= &newfile($cfghash{'BaseDir'} . $cfghash{'ConfigDir'},
$username, $cgi->param('newfile'), $cgi->param('new_rights'));
$headertext = "New File";
}
elsif ($form eq 'confr') {
$page .= &config_rights($cgi->param('configslist'));
$headertext = "Config Rights";
}
elsif ($form eq 'changer') {
$page .= &change_rights($cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/"
. $cgi->param('filename'), $cgi->param('changerights') );
$headertext = "Config Rights";
}
elsif ($form eq 'copyt') {
$page .= ©_file($cgi->param('templatelist') );
$headertext = "Copy File";
}
elsif ($form eq 'copyc') {
$page .= ©_file($cgi->param('configslist'));
$headertext = "Copy File";
}
elsif ($form eq 'copy' ) {
$page .= ©($cgi->param('srcfile'), $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" .
$username . "/". $cgi->param('dstfile'));
$headertext = "Copy File";
}
elsif ($form eq 'del' ) {
$page .= &del($cgi->param('configslist'));
$headertext = "Delete File";
}
elsif ($form eq 'run' ) {
$page .= &run($cgi->param('configslist') );
$headertext = "Run";
}
elsif ($form eq 'admin' ) {
if ( $cgi->param('username') eq $cfghash{'TabeaUser'}) {
$page .= &admin($cgi->param('username') );
$headertext = "Administration";
} else {
$page .= &chpwd($cgi->param('username') );
$headertext = "Change Password";
}
}
elsif ($form eq 'chpwd' ) {
if ( $cgi->param('username') eq $cfghash{'TabeaUser'}) {
$page .= &chpwd($cgi->param('akt_user') );
$headertext = "Change Password";
} else {
$page .= &chpwd($cgi->param('username') );
$headertext = "Change Password";
}
}
elsif ($form eq 'changepwd' ) {
if ( $cgi->param('username') eq $cfghash{'TabeaUser'}) {
$page .= &changepwd($cgi->param('akt_user') );
$headertext = "Change Password";
} else {
$page .= &changepwd($cgi->param('username') );
$headertext = "Change Password";
}
}
elsif ($form eq 'nuser' ) {
$page .= &nuser();
$headertext = "New User";
}
elsif ($form eq 'newuser' ) {
$page .= &newuser($cgi->param('akt_user'));
$headertext = "New User";
}
elsif ($form eq 'duser' ) {
$page .= &duser($akt_user);
$headertext = "Delete User";
}
elsif ($form eq 'd2user' ) {
$page .= &d2user($akt_user);
$headertext = "Delete New User";
}
elsif ($form eq 'd3user' ) {
$page .= &d3user($akt_user);
$headertext = "Delete New User";
}
elsif ($form eq 'cfgedit' ) {
$page .= &cfgedit();
$headertext = "Edit Configuration";
}
elsif ($form eq 'logout' ) {
$cgi->param(-name => 'username', -value => "");
$cgi->param(-name => 'password', -value => "");
$form = '';
goto NEXTFORM;
}
else {
die "no correct dialog found";
}
$page .= $cgi->hidden(-name => 'password', -default => $password);
$page .= $cgi->hidden(-name => 'username', -default => $username);
$page .= $cgi->hidden(-name => 'akt_user', -default => $akt_user);
$page .= $cgi->hidden(-name => 'del_u_files', -default => $cgi->param('del_u_files'));
$page .= $cgi->endform;
my $out = $MY->{TEMPLATE};
$out =~ s|%%BODY%%|$page|s;
if ( ! $headertext ) {
$headertext .= $cfghash{'StdHeader'};
}
$out =~ s|%%TITLE%%|$headertext|s;
print STDOUT $cgi->header(-cookie => $cookies, -expires => '+1s') . $out;
exit(0);
############### End of main part #######################################################
########################################################################################
sub login{
########################################################################################
my $text = '';
$text .=
"<center>" .
"<table border=0 cellspacing=0 cellpadding=0 align=center width=300>" .
"<trcolspan=2>".
"<th colspan=1 heigth=60 >Login<br> </th>".
"</tr>" .
" <trcolspan =2>" .
" <td colspan=2 width=150 height=40>Username:</td>" .
" <td>" .
$cgi->textfield(
-name => 'username',
-default => $username,
-size => 20,
-maxlength => 8
) .
" </td>" .
" </tr>" .
" <tr>" .
" <td colspan=2 width=150>Password:</td>" .
" <td>" .
$cgi->password_field(
-name => 'password',
-value => $password,
-size => 20,
-maxlength => 80
) .
" </td>" .
" </tr>" .
" <tr>" .
" <td colspan=2 align=right height=60>" .
$cgi->reset() .
" </td>" .
" <td>" .
$cgi->submit(-name => 'dialog_mainw', -value => 'login') .
" </td>" .
" </tr>" .
"</table>" .
"</center>" .
&logging("Starting Tabea");
return $text;
}
########################################################################################
########################################################################################
sub mainw {
########################################################################################
my $text = '';
# &validpassword($username, $password, $cfghash{'BaseDir'}.$cfghash{'PasswdFile'})
# || print STDOUT $cgi->redirect(-uri => $cgi->url(-full => 1), -type => "text/html");
if (! &validpassword($username, $password, $cfghash{'BaseDir'}.$cfghash{'PasswdFile'}) ) {
$cgi->param(-name => 'username', -value => "");
$cgi->param(-name => 'password', -value => "");
&logging("User $username password error");
$form = '';
goto NEXTFORM;
}
&logging("User $username login successfull");
my $templatesfiles = &get_name_files($cfghash{'BaseDir'} . $cfghash{'ConfigDir'}, $username, 4);
my $configsfiles = &get_name_files($cfghash{'BaseDir'} . $cfghash{'ConfigDir'}, $username, 6);
$configsfiles .= &get_own_files($cfghash{'BaseDir'} . $cfghash{'ConfigDir'}, $username);
$templatesfiles = &strsort($templatesfiles);
$configsfiles = &strsort($configsfiles);
my @templatesarray = split(/ /,$templatesfiles);
my @configsarray = split(/ /,$configsfiles);
$text .=
# Begin with templates part
"<center>" .
"<br><br>" .
"<table height=60>" .
"<td>" .
"<tr>" .
"<td width=150>" .
"<td width=100 valign=top align=left>" .
"<font size=+1>" .
"Active User:".
"</font>" .
"</td>" .
"<td width=60 valign=top align=left>".
"<font size=+1 color=#FF0000>$username</font><br><br>\n" .
"</td>" .
"</td>" .
"<td valign=top align=left>" .
"<table>" .
"<tr>" .
"<td>".
$cgi->submit(-name => 'dialog_logout', -value => 'Logout') .
"</td>".
"</tr>".
"</table>".
"</td>" .
"</tr>" .
"</td>" .
"</table>".
"<br><br>" .
"<table frame=above> <caption align=center size=+1>Templates</caption>" .
"<td height=100> </td>".
" <td width=300>" .
$cgi->scrolling_list(
-name => 'templatelist',
-value => [@templatesarray],
-size => 3
) .
" </td>" .
" <td>" .
" <table>" .
" <td>" .
" <tr>" .
" <td>" .
$cgi->submit(-name => 'dialog_view', -value => 'View') .
" </td>" .
" </tr>" .
" <tr>" .
" <td>" .
$cgi->submit(-name => 'dialog_copyt', -value => 'Copy') .
" </td>" .
" </tr>" .
" </td>" .
" </table>" .
" </td>" .
" </table>" .
" </td>" .
"</table>" .
# Now the configuration part
"<br><br>" .
"<table frame=above> <caption align=center size=+1>Configuration</caption>" .
"<td height=200> </td>".
" <td width=300>" .
$cgi->scrolling_list(
-name => 'configslist',
-value => [@configsarray],
-size => 12
) .
" </td>" .
" <td>" .
" <table cellspading=0 cellspacing=0 align=center>" .
" <tr><td>" .
$cgi->submit(-name => 'dialog_new', -value => 'New') .
" </td></tr>" .
" <tr><td>" .
$cgi->submit(-name => 'dialog_del', -value => 'Del') .
" </td></tr>" .
" <tr><td>" .
$cgi->submit(-name => 'dialog_edit', -value => 'Edit') .
" </td></tr>" .
" <tr><td>" .
$cgi->submit(-name => 'dialog_copyc', -value => 'Copy') .
" </td></tr>" .
" <tr><td>" .
$cgi->submit(-name => 'dialog_confr', -value => 'Rights') .
" </td></tr>" .
" <tr><td>" .
$cgi->submit(-name => 'dialog_run', -value => 'Run') .
" </td></tr>" .
" <tr><td>" .
$cgi->submit(-name => 'dialog_admin', -value => 'Admin') .
" </td></tr>" .
" </table>" .
" </td>" .
"</table>" .
"</center>";
return $text;
}
########################################################################################
########################################################################################
sub get_name_files {
########################################################################################
my ($dirname, $user, $rights) = @_;
my $filel = '';
my @filelarray;
my $filelist = '';
my $subdir = '';
my $filemode = '';
my $entry = '';
my $dirlist = &readsubdir($dirname . "/");
my @dirarray = split (/ /, $dirlist);
DIR: foreach $subdir (@dirarray) {
next DIR if $subdir eq $user;
$filel = &readdir($dirname . "/" . $subdir . "/");
@filelarray = split (/ /, $filel);
FILE: foreach $entry (@filelarray) {
my $path = $dirname . "/" . $subdir . "/" . $entry;
next FILE if (((stat($dirname . "/" . $subdir . "/" . $entry))[2]) & 07) != $rights;
$filelist .= $subdir . "/" . $entry . " ";
}
}
return $filelist;
}
########################################################################################
########################################################################################
sub get_userlist {
########################################################################################
my ($dirname) = @_;
my $ulist = &readsubdir($dirname . "/");;
return $ulist;
}
########################################################################################
########################################################################################
sub get_own_files {
########################################################################################
my ($dirname, $user) = @_;
my $filelist = '';
my $entry = '';
my $flist = &readdir($dirname . "/" . $user . "/");
my @flistarray = split (/ /,$flist);
foreach $entry (@flistarray) {
$filelist .= $user . "/" . $entry . " ";
}
return $filelist;
}
########################################################################################
########################################################################################
sub edit {
########################################################################################
my ($editfile) = @_;
my $text;
if ($editfile) {
my $filename = $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $editfile;
$text .= &editconfig($filename, 'w', $username) .
$cgi->hidden(-name => 'editfile', -default => $filename );
&logging("Edit file $filename");
} else {
$text .= "<br><br><br><br>" .
"<center><font color=red>Missing filename<br><br><br>\n" .
$cgi->submit(-name => 'dialog_mainw', -value => 'Back') .
"</center>";
&logging("Missing filename");
}
return $text;
}
########################################################################################
########################################################################################
sub save {
########################################################################################
my ($file, $edittext) = @_;
my $text = '';
my $fileout;
$text= "<font size=+2>" .
"Save File: $file<br><br>\n" .
"</font>" .
"<br><br>";
$fileout = IO::File->new(">$file");
if (defined $fileout) {
print $fileout $edittext;
$fileout->close;
if($cgi->param("editfile") =~ ($cfghash{'BaseDir'} . "tabea.cfg") ) {
$password = "";
}
&logging("Saving $file");
$form = 'mainw';
goto NEXTFORM;
} else {
$text .= "<font color=red>Cannot save file<br><br>\n";
&logging("Cannot save $file");
}
$text .= $cgi->submit(-name => 'dialog_mainw', -value => 'Back');
return $text;
}
########################################################################################
########################################################################################
sub view {
########################################################################################
my ($file) = @_;
my $text;
if ($file) {
my $filename = $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $cgi->param('templatelist');
$text .= &editconfig($filename, 'r', $username);
} else {
$text .= "<br><br><br><br>" .
"<center>" .
"<font color=red>Missing filename<br><br><br>\n" .
$cgi->submit(-name => 'dialog_mainw', -value => 'Back').
"</center>" ;
}
return $text;
}
########################################################################################
#########################################################################################
sub new {
########################################################################################
my ($dirname, $user) = @_;
my $text = '';
$text= "<center>" .
"<font size=+2>" .
"New File<br><br>\n" .
"</font>" .
"</center>" .
"<br><br>" .
"<center>" .
"<table spacing=0 cellpadding=0>" .
" <tr>" .
" <td>New Filename: $dirname " . "/" . "$user" . "/" . "</td>" .
" <td>" .
$cgi->textfield(
-name => 'newfile',
-default => '',
-size => 20,
-maxlength => 30
) .
" </td>" .
" </tr>" .
" <tr>" .
"<tr><td><br></td></tr>" .
"<td></td>" .
" <td align=left>" .
$cgi->scrolling_list(
-name => 'new_rights',
-value => ['private', 'protected', 'public'],
-size => 1
) .
" </td>" .
" </tr>" .
"<tr><td><br></td></tr>" .
" <tr>" .
" <td align=right>" .
$cgi->submit(-name => 'dialog_mainw', -value => 'Back') .
"</td>" .
"<td align=left>" .
$cgi->submit(-name => 'dialog_newf', -value => 'Create') .
"</td>" .
" </tr>" .
"</table>" .
"<center>" ;
return $text;
}
########################################################################################
########################################################################################
sub newfile {
########################################################################################
my ($dirname, $user, $newfilename, $newrights) = @_;
my $text = '';
my $newpath = $dirname . "/" . $user . "/" . $newfilename;
my $filesinpath = &readdir($dirname . "/" . $user . "/");
my @filesinpatharray = split(/ /,$filesinpath);
my $canwrite = 1; # true
my $filerights = '';
$text= "<font size=+2>" .
"Creating New File: $newfilename <br><br>" .
"</font><br><br><br>";
foreach (@filesinpatharray) {
if ($_ eq $newfilename) {
$canwrite = 0;
};
}
if ($canwrite) {
if ($newrights eq "private") {
$filerights = '';
} elsif ($newrights eq "protected") {
$filerights = "r";
} elsif ($newrights eq "public") {
$filerights = "rw";
} else {
die "Unknown file rights";
}
$text .= "Creating the new file $newpath<br><br>";
system("touch $newpath") && die "Cannot create new file";
&logging("Creating new file $newpath");
$text .= "Setting new file rights for $newpath<br><br>";
system("chmod u=rw $newpath") && die "Cannot set new file rights";
system("chmod o=$filerights $newpath") && die "Cannot set new file rights";
&logging("Changing filerights of $newpath");
$text .= "<br><br><br>";
$form = 'mainw';
goto NEXTFORM;
$text .= $cgi->submit(-name => 'dialog_mainw', -value => 'Back');
} else {
$text .= "<br><br><br><br>" .
"<center>" .
"<font color=red>Cannot write file. File exists<br><br><br>\n".
$cgi->submit(-name => 'dialog_mainw', -value => 'Back') .
"</center>" ;
&logging("Cannot write $newpath. File exists");
}
return $text;
}
########################################################################################
########################################################################################
sub config_rights {
########################################################################################
my ($namefile) = @_;
my $text = '';
my $defaultright = '';
my $confname = '';
my $filerights = (stat($cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $namefile))[2] & 07;
if ($namefile ne '') {
if ($filerights == 6) {
$defaultright = "public" ;
} elsif ($filerights == 4) {
$defaultright = "protected";
} else {
$defaultright = "private";
}
$text .= "<center>" .
"<font size=+2>" .
"Changing Rights of File<br><br><br>\n" .
"</font>" .
"</center>" ;
$namefile =~ m{^([a-zA-Z0-9!"£\$%^&*()-_=+#~]+)/(.+)}sg;
if ($1 eq $username) {
$text .= "<br><br><br><br>" .
"<center>" .
"<table height=100 width=200>" .
"<tr>" .
" <td>" .
"$namefile<br>" .
" </td>" .
" <td>" .
$cgi->scrolling_list(
-name => 'changerights',
-value => ['private', 'protected', 'public'],
-default => $defaultright,
-size => 1
) .
" </td>" .
"</tr>" .
"<tr>" .
"<td align=right>" .
$cgi->submit(-name => 'dialog_mainw', -value => 'Back') .
"</td>" .
"<td>" .
$cgi->submit(-name => 'dialog_changer', -value => 'Set_rights').
"</td>" .
"</tr>" .
"</td>" .
"</table>" .
"</center>" ;
$confname = $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $namefile;
$text .= $cgi->hidden(-name => 'filename', -default => $namefile ) ;
}
else {
$text .= "<font color=red>You can only change file rights in your own directory<br><br>\n" .
$cgi->submit(-name => 'dialog', -value => 'Back');
&logging("Changing filerights of $namefile not allowed");
}
}
else {
$text .= "<br><br><br><br>" .
"<center>" .
"<font color=red>Missing filename<br><br><br>\n" .
$cgi->submit(-name => 'dialog_mainw', -value => 'Back') .
"</center>" ;
&logging("Cannot change rights of empty filename");
}
return $text;
}
########################################################################################
########################################################################################
sub change_rights {
########################################################################################
my ($filename, $newrights) = @_;
my $text = '';
my $filerights = '';
$text = "<center>" .
"<font size=+2>" .
"Changing rights of file:<br>" .
"</font>" .
"<br><font size=+1> $filename </font> to <font size=+1> $newrights </font><br>" .
"</center>" ;
if ($newrights eq "private") {
$filerights = '';
}
elsif ($newrights eq "protected") {
$filerights = "r";
}
elsif ($newrights eq "public") {
$filerights = "rw";
}
else {
die "Unknown file rights";
&logging("Cannot change to unknown file rights");
}
system("chmod o=$filerights $filename") && die "Cannot set new file rights";
&logging("Changing file rights of $filename to $newrights");
$form = 'mainw';
goto NEXTFORM;
return $text;
}
########################################################################################
########################################################################################
sub copy_file {
########################################################################################
my ($filename) = @_;
my $text = '';
if ($filename) {
my $srcfile = $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $filename;
$text .= $cgi->hidden(-name => 'srcfile', -default => $srcfile ) .
"<center>" .
"<font size=+1>" .
"Copying File<br>" .
"</font>" .
"</center>".
"<br><br><br>" .
"<center>" .
"<table width=300>" .
" <td>Sourcefile :</td>" .
" <td>$srcfile</td>" .
" </tr>" .
" <tr>" .
" <td>Destinationfile:</td>" .
" <td align=left>" .
" <table>" .
" <tr>" .
" <td>" . $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $username . "/</td>" .
" <td>" .
$cgi->textfield(
-name=>'dstfile',
-default=>'',
-size=>30,
-maxlength=>80
) .
" </td>" .
" </tr>" .
" </table>" .
" </td>" .
"<tr>" .
" <td align=right height=60>" .
$cgi->submit(-name => 'dialog_mainw', -value => 'Back').
" </td>" .
" <td>" .
$cgi->submit(-name => 'dialog_copy', -value => 'Copy').
" </td>" .
"</tr>" .
" </tr>" .
"</table>" .
"</center>" ;
}
else {
$text .= "<br><br><br><br>" .
"<center>" .
"<font color=red>Missing filename<br><br><br>\n" .
$cgi->submit(-name => 'dialog_mainw', -value => 'Back') .
"</center>" ;
}
return $text;
}
########################################################################################
########################################################################################
sub del {
########################################################################################
my ($delfile) = @_;
my $text = '';
if ($delfile) {
my $fpath = $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $delfile;
$text = "<font size=+2>" .
"Delete File: $fpath<br><br>\n" .
"</font>" .
"<br><br>";
$delfile =~ m{^([a-zA-Z0-9!"<A3>$%^&*()-_=+#~]+)/(.+)}sg;
if ($1 eq $username) {
system("rm $fpath") && die "Cannot delete file";
&logging("Deleting $fpath");
$form = 'mainw';
goto NEXTFORM;
$text .= $cgi->submit(-name => 'dialog_mainw', -value => 'Back');
}
else {
$text .= "<font color=red>You can only delete file in your own directory<br><br>\n";
&logging("Just delete your own files not $fpath");
}
}
else {
$text .= "<br><br><br><br>" .
"<center>" .
"<font color=red>Missing filename<br><br><br>\n" .
$cgi->submit(-name => 'dialog_mainw', -value => 'Back') .
"</center>";
&logging("Missing filename");
}
return $text;
}
########################################################################################
########################################################################################
sub run {
########################################################################################
my ($runfile) = @_;
my $text = '';
my $rpath = $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $runfile;
my $rcommand = $cfghash{'ExecuteCommand'};
my $output = "/tmp/" . $cfghash{'ExecuteTempFile'};
my $fileoutput;
my $outputtext = '';
if ($runfile eq '') {
$text .= "<br><br><br><br>" .
"<center>" .
"<font color=red>No configuration selected <br><br><br>\n" .
$cgi->submit(-name => 'dialog_mainw', -value => 'Back') .
"</center>" ;
&logging("Cannot run configuration without configuration");
return $text;
}
$rcommand =~ s|%{profile}%|$rpath|s;
if (-e $output) {
system("/bin/rm $output");
}
$text .= "<center>" .
"<font size=+2>" .
"Running Configuration<br><br>\n" .
"</font>" .
"</center>" ;
system("$rcommand > $output 2>&1");
&logging("Running command $rcommand");
$fileoutput = IO::File->new("<$output");
if (defined $fileoutput) {
while (<$fileoutput>) {
$outputtext .= $_;
}
$fileoutput->close();
my $outputhash = {
-name => 'outputwindow',
-default => $outputtext,
-rows => 40,
-columns => 80
};
$outputhash->{readonly} = "";
$text .= "<center>" ."<br>".
"<table width=575>" .
"<td>" .
"Configuration filename:" .
"</td>" .
"<td align=right>" .
$rpath .
"</td>" .
"</table>" .
"<br><br>" .
$cgi->textarea($outputhash) .
"<br><br>" .
"<table>" .
"<tr>" .
"<td align=center width=575 height=60>" .
$cgi->submit(-name => 'dialog_mainw', -value => 'Back') .
"</td>" .
"</tr>" .
"</table>" .
"</center>" ;
}
else {
$text .= "<center>" .
"<font color=red>Run command not working<br><br>\n" .
$cgi->submit(-name => 'dialog_mainw', -value => 'Back') .
"</center>" ;
&logging("Run command $rcommand not working");
}
return $text;
}
########################################################################################
########################################################################################
sub admin {
########################################################################################
my ($user) = @_;
my $text;
my $userlist = &get_userlist($cfghash{'BaseDir'} . $cfghash{'ConfigDir'});
my @userlistarray = split(/\s/, $userlist);
$akt_user = $username;
$text .= "<center>" .
"<font size=+2>" .
"Administration<br><br>\n" .
"</font>" .
"</center>" ;
$text .= "<br><br><br>" .
"<center>" .
"<table width=300 frame=hsides>" .
"<td align=left>".
# $cgi->popup_menu(
# -name => 'akt_user',
# -value => [@userlistarray],
# -default => $username,
# ) .
"<select name=akt_user size=1>" ;
foreach (@userlistarray) {
if ($_ =~ $username) {
$text .= "<option selected>$_</option>" ;
} else {
$text .= "<option>$_</option>" ;
}
}
$text .= "</select>" .
"</td>" .
"<td align=right>" .
"<table>" .
"<tr>" .
"<td align=right>" .
$cgi->submit(-name => 'dialog_nuser', -value => 'New User').
"</td>" .
"</tr>" .
"<tr>" .
"<td align=right>" .
$cgi->submit(-name => 'dialog_duser', -value => 'Del User').
"</td>" .
"</tr>" .
"</table>" .
"</td>" .
"</table>" .
"<br><br><br>" .
"<table height=60 frame=hsides>" .
"<td align=left>" .
$cgi->submit(-name => 'dialog_cfgedit', -value => 'Edit Configuration') .
"</td>" .
"<td align=right>" .
$cgi->submit(-name => 'dialog_chpwd', -value => 'Change Password') .
"</td>" .
"</table>" .
"<br><br>" .
$cgi->submit(-name => 'dialog_mainw', -value => 'Back') .
"</center>" ;
return $text;
}
########################################################################################
########################################################################################
sub chpwd {
########################################################################################
my ($user) = @_;
my $ctext;
my $texttitle;
if ($user =~ $cfghash{'TabeaUser'}) {
$texttitle = "Administration: Change Password";
} else {
$texttitle = "Change Password";
}
$ctext .= "<center>" .
"<font size=+2>" .
$texttitle . "<br><br>\n" .
"</font>" .
"</center>" ;
$ctext .= "<center>" .
"<table cellspacing=0 cellpadding=0 width=500>" ;
if ( (($username eq $cfghash{'TabeaUser'}) && ($user eq $cfghash{'TabeaUser'}) )
|| ($username ne $cfghash{'TabeaUser'}) ) {
$ctext .= "<tr height=80>" .
"<td>Changing the password of </td><td align=left>$user</td>" .
"</tr>" .
"<tr>" .
" <td>Old Password:</td>" .
" <td>" .
$cgi->password_field(
-name => 'old_password',
-value => $old_password,
-size => 20,
-maxlength => 80
) .
" </td>" .
" </tr>" ;
}
$ctext .= " <tr>" .
" <td>New Password:</td>" .
" <td>" .
$cgi->password_field(
-name => 'new1_password',
-value => $new1_password,
-size => 20,
-maxlength => 80
) .
" </td>" .
" </tr>" .
" </tr>" .
" <tr>" .
" <td>Repeat Password:</td>" .
" <td>" .
$cgi->password_field(
-name => 'new2_password',
-value => $new2_password,
-size => 20,
-maxlength => 80
) .
" </td>" .
" </tr>" .
" <tr height=60>" .
" <td align=left>" ;
if ( $cgi->param('username') eq $cfghash{'TabeaUser'}) {
$ctext .= $cgi->submit(-name => 'dialog_admin', -value => 'Back');
} else {
$ctext .= $cgi->submit(-name => 'dialog_mainw', -value => 'Back');
}
$ctext .= "</td>" .
"<td align=left>" .
$cgi->reset() .
$cgi->submit(-name => 'dialog_changepwd', -value => 'Change') .
"</td>" .
"</tr>" .
"</td>" .
"</table>" .
"</center>" ;
return $ctext;
}
########################################################################################
########################################################################################
sub changepwd {
########################################################################################
my ($user) = @_;
my $cptext;
my $valid;
my $uname;
my $pwd;
my $pwdfp;
my $pwdfile = $cfghash{'BaseDir'}.$cfghash{'PasswdFile'};
my $pwfiletext;
my @pwarray;
my $akt_u_p;
&logging("Changing password of user $user");
$valid = &validpassword($user, $old_password, $cfghash{'BaseDir'}.$cfghash{'PasswdFile'});
if ( ($username eq $cfghash{'TabeaUser'}) && ($user ne $cfghash{'TabeaUser'}) ) {
$valid = 1;
}
if ( !$valid ) {
$cptext .= "<center>" .
"<font color=red>The password is incorrect.<br><br>\n";
&logging("Password is incorrect");
if ( $cgi->param('username') eq $cfghash{'TabeaUser'}) {
$cptext .= $cgi->submit(-name => 'dialog_admin', -value => 'Back');
} else {
$cptext .= $cgi->submit(-name => 'dialog_mainw', -value => 'Back');
}
$cptext .= "</center>";
} else {
if ($new1_password eq $new2_password) {
$pwdfp = IO::File->new("<$pwdfile");
$pwfiletext .= $_ while (<$pwdfp>);
@pwarray = split(/\s/, $pwfiletext);
foreach (@pwarray) {
$akt_u_p = $_;
$akt_u_p =~ s|^(\w+):(.+)$|{$uname=$1; $pwd=$2}|eg;
( $uname =~ $user ) && do { $_ = $username .":". crypt($new1_password, $pwd); }
}
$pwdfp->close();
$pwfiletext = join("\n", @pwarray);
$pwdfp = IO::File->new(">$pwdfile");
print $pwdfp $pwfiletext;
$pwdfp->close();
&logging("Writing new password for user $user");
if ( $user =~ $username) {$password=$new1_password;}
$form = 'mainw';
goto NEXTFORM;
} else {
$cptext .= "<center>" .
"<font color=red>The password you typed do not match. Type the same password. ".
"in both boxes<br><br>\n".
$cgi->submit(-name => 'dialog_mainw', -value => 'Back') .
"</center>" ;
&logging("The password in the two boxes are not the same");
}
}
ENDE:
return $cptext;
}
########################################################################################
########################################################################################
sub nuser {
########################################################################################
my $text;
$text .= "<center>" .
"<font size=+2>" .
"Administration: New User<br><br>\n" .
"</font>" .
"</center>" .
"<br><br><br>" .
"<center>" .
"<table>" .
"<tr height=60>" .
"<td>New User:</td>" .
"<td>" .
$cgi->textfield(
-name => 'akt_user',
-default => "",
-override => 1,
-size => 20,
-maxlength => 8
) .
" </td>" .
" </tr>" .
"<tr height=60>" .
"<td align=right>" .
$cgi->submit(-name => 'dialog_admin', -value => 'Back').
"</td>" .
"<td>" .
$cgi->submit(-name => 'dialog_newuser', -value => 'Create User').
"</td>" .
"</tr>" .
"</table>" .
"</center>" ;
return $text;
}
########################################################################################
########################################################################################
sub newuser {
########################################################################################
my ($nuser) = @_;
my $ntext;
my $pwdfile = $cfghash{'BaseDir'}.$cfghash{'PasswdFile'};
my $pwdin;
my $pwdfiletext;
my $pwd;
my $uname;
my $dirlist;
my $nu_error = 1;
if ( $nuser !~ /^[A-Za-z0-9]+$/ ) {
$nuser = "";
}
$ntext .= "<center>" .
"<font size=+2>" .
"Administration: New User<br><br>\n" .
"</font>" .
"</center>" ;
if ( $nuser eq "" ) {
$ntext .= "<center>".
"<font color=red>" .
"<br>Username wrong<br><br>" .
"</font>" .
$cgi->submit(-name => 'dialog_admin', -value => 'Back') .
"</center>" ;
&logging("Username is wrong");
} else {
$pwdin = IO::File->new("<$pwdfile");
while (<$pwdin>) {
$_ =~ s|^(\w+):(.+)$|{$uname=$1}|eg;
( $uname =~ $nuser ) && do { $nu_error = 0; };
}
$pwdin->close();
$dirlist = &readsubdir($cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/");
( $dirlist =~ m|$nuser| ) && do { $nu_error = 0; };
if ($nu_error) {
my $newdir = $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $nuser;
system("mkdir $newdir ") ;
$dirlist = &readsubdir($cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/");
my $dirok = 1;
( $dirlist !~ m|$nuser| ) && do { $dirok = 0; };
if ($dirok) {
$pwdin = IO::File->new("<$pwdfile");
while (<$pwdin>) {
$pwdfiletext .= $_;
$_ =~ s|^(\w+):(.+)$|{$uname=$1; $pwd=$2}|eg;
# I need an existing password as an example
}
$pwdin->close();
$pwdfiletext .= $nuser . ":" . (crypt('foobar', $pwd)) ;
$pwdin = IO::File->new(">$pwdfile");
print $pwdin $pwdfiletext;
$pwdin->close();
}
$ntext .= "<enter>".
"<font color=red>" .
"User $nuser created</font><br><br>" .
$cgi->submit(-name => 'dialog_admin', -value => 'Back').
"</center>" ;
&logging("New use $nuser created");
} else {
$ntext .= "<center>" .
"<font color=red>" .
"<br>User exists <br><br>" .
"</font>" .
$cgi->submit(-name => 'dialog_admin', -value => 'Back') .
"</center>";
&logging("Cannot create user $nuser. The user exists.")
}
}
return $ntext;
}
########################################################################################
########################################################################################
sub duser {
########################################################################################
my ($duser) = @_;
my $text;
my $derror = 0;
if ($duser =~ m/^$cfghash{'TabeaUser'}$/ ) {
$derror = 1;
}
if (! $derror ) {
$text .= "<center>" .
"<font size=+2>" .
"Administration: Delete User<br><br>\n" .
"</font>" .
"</center>" .
"<br><br><br>" .
"<center>" .
"<table width=200>" .
"<td>" .
"User to delete :" .
"</td>".
"<td>" .
"<font color=red>" .
"$duser" .
"</font>" .
"</td>" .
"</table>" .
"<br><br>" .
# $cgi->checkbox(-name=>'del_u_files',
# -value=>'del_files',
# -checked=>'',
# -label=>'Delete files of user',
# -checked=>
# ) .
"<input type=\"checkbox\" name=\"del_u_files\" value=\"del_files\" />Delete files of user" .
"<br><br>" .
"<table width=200 height=60>" .
"<td align=right>" .
$cgi->submit(-name => 'dialog_admin', -value => 'Back').
"</td>" .
"<td>" .
$cgi->submit(-name => 'dialog_d2user', -value => 'Del User').
"</td>" .
"</table>" .
"</center>" ;
} else {
$text .=
"<font color=red>" .
"It is not allowed to delete tabea user!!!" .
"</font>" .
"<br><br>" .
$cgi->submit(-name => 'dialog_admin', -value => 'Back');
&logging("The Tabea user cannot be deleted");
}
return $text;
}
########################################################################################
########################################################################################
sub d2user {
########################################################################################
my ($duser) = @_;
my $dtext;
$dtext .= "<center>" .
"<font size=+2>" .
"Administration: Delete User<br><br>\n" .
"</font>" .
"</center>" .
"<br><br><br>" .
"<center>" .
"<table>" .
"<td>" .
"User to delete :" .
"</td>".
"<td>" .
"<font color=red>" .
"$duser" .
"</font>" .
"</td>" .
"</table>" ;
if ($cgi->param('del_u_files')) {
$dtext .= "<br>The files of the user will be deleted" ;
} else {
$dtext .= "<br>The files of the user will be copied" ;
}
$dtext .= "<br><br><br>" .
"<table>" .
"<td>" .
$cgi->submit(-name => 'dialog_admin', -value => 'Back').
"</td>" .
"<td>" .
$cgi->submit(-name => 'dialog_d3user', -value => 'Really delete user').
"</td>" .
"</table>" .
"</center>" ;
return $dtext;
}
########################################################################################
########################################################################################
sub d3user {
########################################################################################
my ($duser) = @_;
my $d3text;
my $delfiles = $cgi->param('del_u_files');
my $deldir = $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $duser . "/" ;
my $pwdfile = $cfghash{'BaseDir'}.$cfghash{'PasswdFile'};
my $pwdin;
my $temptxt;
my $pwdfiletext;
my $uname;
$d3text .= "<center>" .
"<font size=+2>" .
"Administration: Delete User<br><br>\n" .
"</font>" .
"</center>" .
"<br><br><br>" .
"<center>" .
"<table>" .
"<td>" .
"Deleting user:" .
"</td>".
"<td>" .
"<font color=red>" .
"$duser" .
"</font>" .
"</td>" .
"</table>" .
"<br>" ;
if ( ! $cgi->param('del_u_files')) {
my $destdir = $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $cfghash {'TabeaUser'} ."/" ;
my $copyfiles = &readdir($deldir);
my @copfilesarray = split(/ /,$copyfiles);
foreach (@copfilesarray) {
system("cp $deldir$_ $destdir$duser.$_") && die "Copy failed";
&logging("The files of $duser saved");
}
}
system("rm -rf $deldir");
$pwdin = IO::File->new("<$pwdfile");
while (<$pwdin>) {
$temptxt = $_ ;
$_ =~ s|^(\w+):(.+)$|{$uname=$1}|eg;
if ($uname !~ $duser) { $pwdfiletext .= $temptxt; }
}
$pwdin->close();
$pwdin = IO::File->new(">$pwdfile");
print $pwdin $pwdfiletext;
$pwdin->close();
&logging("User $duser deleted");
$d3text .= "<br>" .
$cgi->submit(-name => 'dialog_admin', -value => 'Back') .
"</center>" ;
return $d3text;
}
########################################################################################
########################################################################################
sub cfgedit {
########################################################################################
my $text;
&logging("Editing Tabea configuration");
$text .= &editconfig($cfghash{'BaseDir'} . "tabea.cfg", 'w', $cfghash{'TabeaUser'} );
$text .= $cgi->hidden(-name => 'editfile', -default => $cfghash{'BaseDir'} . "tabea.cfg" );
return $text;
}
########################################################################################
########################################################################################
sub copy {
########################################################################################
my ($srcf, $dstf) = @_;
my $text = '';
$text .= "<center>" .
"<font size=+1>" .
"Copying File:<br>" .
"</font>" .
"</center>" .
"<br><br>" .
"<center>" .
"Copying from <font size=+1>$srcf</font> to <font size=+1>$dstf</font><br><br>".
"</center>" ;
system("cp $srcf $dstf") && die "Cannot copy file";
system("chmod o= $dstf") && die "Cannot change file rights";
&logging("Copying $srcf to $dstf");
$form = 'mainw';
goto NEXTFORM;
return $text;
}
########################################################################################
########################################################################################
sub read_config {
########################################################################################
my ($cfgfile) = @_;
my %cfghash ;
my $cfgin ;
my $key;
my $content;
$cfgin = IO::File->new("<$cfgfile");
if (defined $cfgin) {
LOOP: while(<$cfgin>) {
$_ =~ s|^\s+(.*?)|{$_=$1}|es; # Remove whitespaces at the beginning
next LOOP if $_ =~ /^\n/; # Remove the first empty require
next LOOP if $_ eq ""; # Remove empty line
next LOOP if $_ =~/^#/; # Remove comment lines
$_ =~ s|^([^#]+)#(.*)$|{$_=$1}|es; # Remove comments on the end
$_ =~ s|(.*?)\s+$|{$_=$1}|es; # Remove whitespaces at the end
($key, $content) = /^(\w+)\s+(.*)$/;
$cfghash{$key} = $content;
}
$cfgin->close;
}
else {
die "Can't open config file";
}
return (%cfghash);
}
########################################################################################
########################################################################################
sub validpassword {
########################################################################################
my ($user, $password, $pwdfile) = @_;
my $returnvalue = 0;
my $uname;
my $pwd;
my $pwdin;
$pwdin = IO::File->new("<$pwdfile");
if(defined $pwdin) {
while (<$pwdin>) {
$_ =~ s|^(\w+):(.+)$|{$uname=$1; $pwd=$2}|eg;
( $uname =~ $user ) && do { # check the password
if (crypt($password, $pwd) eq $pwd){
$returnvalue = 1;
}
}
}
}
$pwdin->close();
return $returnvalue;
}
########################################################################################
########################################################################################
sub readsubdir {
########################################################################################
my ($dir) = @_;
my $filestring = "";
my $direntry = "";
opendir(DIR, "$dir");
foreach $direntry (readdir(DIR)) {
next if $direntry eq ".";
next if $direntry eq "..";
if (-d "$dir/$direntry") {
$filestring .= $direntry . " ";
}
}
closedir(DIR);
return $filestring;
}
########################################################################################
########################################################################################
sub readdir {
########################################################################################
my ($dir) = @_;
my $filestring = "";
my $direntry = "";
opendir(DIR, "$dir");
foreach $direntry (readdir(DIR)) {
next if $direntry eq ".";
next if $direntry eq "..";
if (-f "$dir/$direntry") {
$filestring .= $direntry . " ";
}
}
closedir(DIR);
return $filestring;
}
########################################################################################
########################################################################################
sub strsort {
########################################################################################
my ($sortstr) = @_;
my @sortarray = split(/ /, $sortstr);
@sortarray = reverse sort {$b cmp $a} @sortarray;
$sortstr = join(" ", @sortarray);
return $sortstr;
}
########################################################################################
########################################################################################
sub editconfig {
########################################################################################
my ($file, $mode, $user) = @_;
my $texte = '';
my $filein ;
my $editf = '';
my $readonly ;
my $titletext ;
$filein = IO::File->new("<$file");
if (defined $filein) {
while(<$filein>) {
$editf .= $_;
}
$filein->close();
}
else {
&logging("Cannot open $file");
die "Can't open $file";
}
if ($mode eq 'w') {
$titletext = "Edit window";
} elsif ($mode eq 'r') {
$titletext = "View window";
}
my $textahash = {
-name => 'editwindow',
-default => $editf,
-rows => 40,
-columns => 80
};
if ($mode eq 'r') {
$textahash->{readonly}="";
}
$texte .= "<center>" .
"<font size=+2>" .
$titletext . "<br><br>\n" .
"</font>" .
"</center>" .
"<br>" .
"<center>" .
"<table width=500>" .
"<td>".
"<tr>" .
"<td align=center>".
"<font size=+1>File:</font>" .
"</td>".
"<td align=center>".
"<font size=+1>$file</font>".
"</td>\n" .
"</tr>" .
"</table>" .
"<br>" .
$cgi->textarea($textahash).
"<br><br>\n" .
"<table width=500>" .
" <td>" .
" <td align=center>" .
$cgi->submit(-name => 'dialog_mainw', -value => 'Back') .
" </td>";
if ($mode eq 'w') {
$texte .= " <td align=center>" .
$cgi->submit(-name => 'dialog_save', -value => 'Save') .
" </td>";
}
$texte .= " <td>" .
" </td>" .
"</table>" .
"</td>" .
"</table>" .
"</center>" ;
return $texte;
}
########################################################################################
########################################################################################
sub logging{
########################################################################################
my ($logtext) = @_;
my $logfile = $cfghash{'BaseDir'} . $cfghash{'LogFile'};
my $logout;
my $entry;
if ( $cfghash{'Logging'} =~ /^[yY][eE][sS]$/) {
my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time);
my $month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec') [($mon)];
my $Year = $year + 1900;
my $Day = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat') [($wday)];
$entry = sprintf("[%s %s %s %02i:%02i:%02i %s] ",$Day,$month,$mday,$hour,$min,$sec,$Year);
$entry .= $logtext . "\n";
$logout = IO::File->new($logfile, "a");
if (defined $logout) {
print $logout $entry;
} else {
die "Cannot open log file $logfile";
}
}
}
########################################################################################
