#!/usr/opkg/bin/perl -w ## ## OSSP tabea - Web Configuration Editor ## Copyright (c) 2001-2002 The OSSP Project ## Copyright (c) 2001-2002 Cable & Wireless Deutschland ## ## 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|
\n|sg; print STDOUT $cgi->header(-expires => '+1s') . "Tabea :: ERROR", "

Tabea :: ERROR

\n" . "
$err
\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 .= "
" . "" . "". "". "" . " " . " " . " " . " " . " " . " " . " " . " " . " " . " " . " " . " " . "
Login
 
Username:" . $cgi->textfield( -name => 'username', -default => $username, -size => 20, -maxlength => 8 ) . "
Password:" . $cgi->password_field( -name => 'password', -value => $password, -size => 20, -maxlength => 80 ) . "
" . $cgi->reset() . " " . $cgi->submit(-name => 'dialog_mainw', -value => 'login') . "
" . "
" . &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 "
" . "

" . "" . "" . "" . "" . "" . "" . "" . "" . "
" . "
" . "" . "" . "Active User:". "" . "". "$username

\n" . "
" . "" . "" . "". "". "
". $cgi->submit(-name => 'dialog_logout', -value => 'Logout') . "
". "
". "

" . "" . "". " " . " " . "
Templates
" . $cgi->scrolling_list( -name => 'templatelist', -value => [@templatesarray], -size => 3 ) . " " . " " . " " . " " . " " . " " . " " . " " . " " . "
" . "
" . $cgi->submit(-name => 'dialog_view', -value => 'View') . "
" . $cgi->submit(-name => 'dialog_copyt', -value => 'Copy') . "
" . "
" . " " . "" . # Now the configuration part "

" . "" . "". " " . " " . "
Configuration
" . $cgi->scrolling_list( -name => 'configslist', -value => [@configsarray], -size => 12 ) . " " . " " . " " . " " . " " . " " . " " . " " . " " . "
" . $cgi->submit(-name => 'dialog_new', -value => 'New') . "
" . $cgi->submit(-name => 'dialog_del', -value => 'Del') . "
" . $cgi->submit(-name => 'dialog_edit', -value => 'Edit') . "
" . $cgi->submit(-name => 'dialog_copyc', -value => 'Copy') . "
" . $cgi->submit(-name => 'dialog_confr', -value => 'Rights') . "
" . $cgi->submit(-name => 'dialog_run', -value => 'Run') . "
" . $cgi->submit(-name => 'dialog_admin', -value => 'Admin') . "
" . "
" . "
"; 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 .= "



" . "
Missing filename


\n" . $cgi->submit(-name => 'dialog_mainw', -value => 'Back') . "
"; &logging("Missing filename"); } return $text; } ######################################################################################## ######################################################################################## sub save { ######################################################################################## my ($file, $edittext) = @_; my $text = ''; my $fileout; $text= "" . "Save File: $file

\n" . "
" . "

"; $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 .= "Cannot save file

\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 .= "



" . "
" . "Missing filename


\n" . $cgi->submit(-name => 'dialog_mainw', -value => 'Back'). "
" ; } return $text; } ######################################################################################## ######################################################################################### sub new { ######################################################################################## my ($dirname, $user) = @_; my $text = ''; $text= "
" . "" . "New File

\n" . "
" . "
" . "

" . "
" . "" . " " . " " . " " . " " . " " . "" . "" . " " . " " . "" . " " . " " . "" . " " . "
New Filename: $dirname " . "/" . "$user" . "/" . "" . $cgi->textfield( -name => 'newfile', -default => '', -size => 20, -maxlength => 30 ) . "

" . $cgi->scrolling_list( -name => 'new_rights', -value => ['private', 'protected', 'public'], -size => 1 ) . "

" . $cgi->submit(-name => 'dialog_mainw', -value => 'Back') . "" . $cgi->submit(-name => 'dialog_newf', -value => 'Create') . "
" . "
" ; 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= "" . "Creating New File: $newfilename

" . "



"; 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

"; system("touch $newpath") && die "Cannot create new file"; &logging("Creating new file $newpath"); $text .= "Setting new file rights for $newpath

"; 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 .= "


"; $form = 'mainw'; goto NEXTFORM; $text .= $cgi->submit(-name => 'dialog_mainw', -value => 'Back'); } else { $text .= "



" . "
" . "Cannot write file. File exists


\n". $cgi->submit(-name => 'dialog_mainw', -value => 'Back') . "
" ; &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 .= "
" . "" . "Changing Rights of File


\n" . "
" . "
" ; $namefile =~ m{^([a-zA-Z0-9!"£\$%^&*()-_=+#~]+)/(.+)}sg; if ($1 eq $username) { $text .= "



" . "
" . "" . "" . " " . " " . "" . "" . "" . "" . "" . "" . "
" . "$namefile
" . "
" . $cgi->scrolling_list( -name => 'changerights', -value => ['private', 'protected', 'public'], -default => $defaultright, -size => 1 ) . "
" . $cgi->submit(-name => 'dialog_mainw', -value => 'Back') . "" . $cgi->submit(-name => 'dialog_changer', -value => 'Set_rights'). "
" . "
" ; $confname = $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $namefile; $text .= $cgi->hidden(-name => 'filename', -default => $namefile ) ; } else { $text .= "You can only change file rights in your own directory

\n" . $cgi->submit(-name => 'dialog', -value => 'Back'); &logging("Changing filerights of $namefile not allowed"); } } else { $text .= "



" . "
" . "Missing filename


\n" . $cgi->submit(-name => 'dialog_mainw', -value => 'Back') . "
" ; &logging("Cannot change rights of empty filename"); } return $text; } ######################################################################################## ######################################################################################## sub change_rights { ######################################################################################## my ($filename, $newrights) = @_; my $text = ''; my $filerights = ''; $text = "
" . "" . "Changing rights of file:
" . "
" . "
$filename to $newrights
" . "
" ; 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 ) . "
" . "" . "Copying File
" . "
" . "
". "


" . "
" . "" . " " . " " . " " . " " . " " . " " . "" . " " . " " . "" . " " . "
Sourcefile :$srcfile
Destinationfile:" . " " . " " . " " . " " . " " . "
" . $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $username . "/" . $cgi->textfield( -name=>'dstfile', -default=>'', -size=>30, -maxlength=>80 ) . "
" . "
" . $cgi->submit(-name => 'dialog_mainw', -value => 'Back'). " " . $cgi->submit(-name => 'dialog_copy', -value => 'Copy'). "
" . "
" ; } else { $text .= "



" . "
" . "Missing filename


\n" . $cgi->submit(-name => 'dialog_mainw', -value => 'Back') . "
" ; } return $text; } ######################################################################################## ######################################################################################## sub del { ######################################################################################## my ($delfile) = @_; my $text = ''; if ($delfile) { my $fpath = $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $delfile; $text = "" . "Delete File: $fpath

\n" . "
" . "

"; $delfile =~ m{^([a-zA-Z0-9!"$%^&*()-_=+#~]+)/(.+)}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 .= "You can only delete file in your own directory

\n"; &logging("Just delete your own files not $fpath"); } } else { $text .= "



" . "
" . "Missing filename


\n" . $cgi->submit(-name => 'dialog_mainw', -value => 'Back') . "
"; &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 .= "



" . "
" . "No configuration selected


\n" . $cgi->submit(-name => 'dialog_mainw', -value => 'Back') . "
" ; &logging("Cannot run configuration without configuration"); return $text; } $rcommand =~ s|%{profile}%|$rpath|s; if (-e $output) { system("/bin/rm $output"); } $text .= "
" . "" . "Running Configuration

\n" . "
" . "
" ; 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 .= "
" ."
". "" . "" . "" . "
" . "Configuration filename:" . "" . $rpath . "
" . "

" . $cgi->textarea($outputhash) . "

" . "" . "" . "" . "" . "
" . $cgi->submit(-name => 'dialog_mainw', -value => 'Back') . "
" . "
" ; } else { $text .= "
" . "Run command not working

\n" . $cgi->submit(-name => 'dialog_mainw', -value => 'Back') . "
" ; &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 .= "
" . "" . "Administration

\n" . "
" . "
" ; $text .= "


" . "
" . "" . "" . "" . "
". # $cgi->popup_menu( # -name => 'akt_user', # -value => [@userlistarray], # -default => $username, # ) . "" . "" . "" . "" . "" . "" . "" . "" . "" . "
" . $cgi->submit(-name => 'dialog_nuser', -value => 'New User'). "
" . $cgi->submit(-name => 'dialog_duser', -value => 'Del User'). "
" . "
" . "


" . "" . "" . "" . "
" . $cgi->submit(-name => 'dialog_cfgedit', -value => 'Edit Configuration') . "" . $cgi->submit(-name => 'dialog_chpwd', -value => 'Change Password') . "
" . "

" . $cgi->submit(-name => 'dialog_mainw', -value => 'Back') . "
" ; return $text; } ######################################################################################## ######################################################################################## sub chpwd { ######################################################################################## my ($user) = @_; my $ctext; my $texttitle; if ($user =~ $cfghash{'TabeaUser'}) { $texttitle = "Administration: Change Password"; } else { $texttitle = "Change Password"; } $ctext .= "
" . "" . $texttitle . "

\n" . "
" . "
" ; $ctext .= "
" . "" ; if ( (($username eq $cfghash{'TabeaUser'}) && ($user eq $cfghash{'TabeaUser'}) ) || ($username ne $cfghash{'TabeaUser'}) ) { $ctext .= "" . "" . "" . "" . " " . " " . " " ; } $ctext .= " " . " " . " " . " " . " " . " " . " " . " " . " " . " " . " " . "" . "" . "" . "
Changing the password of $user
Old Password:" . $cgi->password_field( -name => 'old_password', -value => $old_password, -size => 20, -maxlength => 80 ) . "
New Password:" . $cgi->password_field( -name => 'new1_password', -value => $new1_password, -size => 20, -maxlength => 80 ) . "
Repeat Password:" . $cgi->password_field( -name => 'new2_password', -value => $new2_password, -size => 20, -maxlength => 80 ) . "
" ; 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 .= "" . $cgi->reset() . $cgi->submit(-name => 'dialog_changepwd', -value => 'Change') . "
" . "
" ; 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 .= "
" . "The password is incorrect.

\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 .= "
"; } 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 .= "
" . "The password you typed do not match. Type the same password. ". "in both boxes

\n". $cgi->submit(-name => 'dialog_mainw', -value => 'Back') . "
" ; &logging("The password in the two boxes are not the same"); } } ENDE: return $cptext; } ######################################################################################## ######################################################################################## sub nuser { ######################################################################################## my $text; $text .= "
" . "" . "Administration: New User

\n" . "
" . "
" . "


" . "
" . "" . "" . "" . "" . " " . "" . "" . "" . "" . "
New User:" . $cgi->textfield( -name => 'akt_user', -default => "", -override => 1, -size => 20, -maxlength => 8 ) . "
" . $cgi->submit(-name => 'dialog_admin', -value => 'Back'). "" . $cgi->submit(-name => 'dialog_newuser', -value => 'Create User'). "
" . "
" ; 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 .= "
" . "" . "Administration: New User

\n" . "
" . "
" ; if ( $nuser eq "" ) { $ntext .= "
". "" . "
Username wrong

" . "
" . $cgi->submit(-name => 'dialog_admin', -value => 'Back') . "
" ; &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 .= "". "" . "User $nuser created

" . $cgi->submit(-name => 'dialog_admin', -value => 'Back'). "
" ; &logging("New use $nuser created"); } else { $ntext .= "
" . "" . "
User exists

" . "
" . $cgi->submit(-name => 'dialog_admin', -value => 'Back') . "
"; &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 .= "
" . "" . "Administration: Delete User

\n" . "
" . "
" . "


" . "
" . "" . "". "" . "
" . "User to delete :" . "" . "" . "$duser" . "" . "
" . "

" . # $cgi->checkbox(-name=>'del_u_files', # -value=>'del_files', # -checked=>'', # -label=>'Delete files of user', # -checked=> # ) . "Delete files of user" . "

" . "" . "" . "" . "
" . $cgi->submit(-name => 'dialog_admin', -value => 'Back'). "" . $cgi->submit(-name => 'dialog_d2user', -value => 'Del User'). "
" . "
" ; } else { $text .= "" . "It is not allowed to delete tabea user!!!" . "" . "

" . $cgi->submit(-name => 'dialog_admin', -value => 'Back'); &logging("The Tabea user cannot be deleted"); } return $text; } ######################################################################################## ######################################################################################## sub d2user { ######################################################################################## my ($duser) = @_; my $dtext; $dtext .= "
" . "" . "Administration: Delete User

\n" . "
" . "
" . "


" . "
" . "" . "". "" . "
" . "User to delete :" . "" . "" . "$duser" . "" . "
" ; if ($cgi->param('del_u_files')) { $dtext .= "
The files of the user will be deleted" ; } else { $dtext .= "
The files of the user will be copied" ; } $dtext .= "


" . "" . "" . "" . "
" . $cgi->submit(-name => 'dialog_admin', -value => 'Back'). "" . $cgi->submit(-name => 'dialog_d3user', -value => 'Really delete user'). "
" . "
" ; 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 .= "
" . "" . "Administration: Delete User

\n" . "
" . "
" . "


" . "
" . "" . "". "" . "
" . "Deleting user:" . "" . "" . "$duser" . "" . "
" . "
" ; 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 .= "
" . $cgi->submit(-name => 'dialog_admin', -value => 'Back') . "
" ; 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 .= "
" . "" . "Copying File:
" . "
" . "
" . "

" . "
" . "Copying from $srcf to $dstf

". "
" ; 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 .= "
" . "" . $titletext . "

\n" . "
" . "
" . "
" . "
" . "" . "" . "". "\n" . "" . "
". "
". "File:" . "". "$file". "
" . "
" . $cgi->textarea($textahash). "

\n" . "" . " "; if ($mode eq 'w') { $texte .= " "; } $texte .= " " . "
" . " " . $cgi->submit(-name => 'dialog_mainw', -value => 'Back') . " " . $cgi->submit(-name => 'dialog_save', -value => 'Save') . " " . "
" . "" . "" . "
" ; 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"; } } } ########################################################################################