ossp-pkg/tabea/tabea.cgi
1.16
#!/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"; # Name of configuration file
my $pwdfile = "./tabea.pw";
my $configsdir = "./tabea.d";
#my $tabeauser = "tabea";
# establish my configuration
my $MY = {};
$MY->{PROGNAME} = ($0 =~ m|^.*?([^/]+?)(?:\.[^/.]+)?$|)[0];
$MY->{TEMPLATE} = '';
my $fh = new IO::File ("<".$MY->{PROGNAME}.".html") || die;
$MY->{TEMPLATE} .= $_ while (<$fh>);
$fh->close();
# 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);
#print "Test: $cfghash{'TabeaUser'}\n";
# fetch parameters
my $dialog = $cgi->param("dialog") || "";
my $username = $cgi->param("username") || "";
my $password = $cgi->param("password") || "";
my $page = '';
if ($cfghash{"TabeaUser"} ne '') {
if ($dialog eq "") {
$page .= $cgi->startform( -method => "POST", -action => $cgi->url(-full => 1)) .
# $cgi->hidden(-name => 'form', -default => ['login']) .
"<table cellspacing=0 cellpadding=0>" .
" <tr>" .
" <td>Username:</td>" .
" <td>" .
$cgi->textfield(
-name => 'username',
-default => $username,
-size => 20,
-maxlength => 8
) .
" </td>" .
" </tr>" .
" <tr>" .
" <td>Password:</td>" .
" <td>" .
$cgi->password_field(
-name => 'password',
-value => $password,
-size => 20,
-maxlength => 80
) .
" </td>" .
" </tr>" .
" <tr>" .
" <td colspan=2 align=right>" .
$cgi->reset() .
$cgi->submit(-name => 'dialog', -value => 'login') .
" </td>" .
" </tr>" .
"</table>" .
$cgi->endform;
}
elsif (($dialog eq 'login') || ($dialog eq 'Back')) {
# enter Select form
&validpassword($username, $password, $cfghash{'BaseDir'}.$cfghash{'PasswdFile'}) || print STDOUT $cgi->redirect(-uri => $cgi->url(-full => 1), -type => "text/html");
# my $templatesfiles = &readdir($cfghash{'BaseDir'} . $cfghash{'ConfigDir'} ."/".$cfghash{'TabeaUser'});
# my $configsfiles = &readdir($cfghash{'BaseDir'} . $cfghash{'ConfigDir'} ."/".$username);
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);
#
$page .= $cgi->startform( -method => "POST", -action => $cgi->url(-full => 1)) .
$cgi->hidden(-name => 'form', -default => ['']) .
# Begin with templates part
"<font size=+1>" .
"<br> Active User: $username<br><br>\n" .
"</font>" .
"<table> <caption>Templates</caption>" .
" <td>" .
" <td>" .
$cgi->scrolling_list(
-name => 'templatelist',
-value => [@templatesarray],
-size => 3
) .
" </td>" .
" <td>" .
" <table>" .
" <td>" .
" <tr>" .
" <td>" .
$cgi->submit(-name => 'dialog', -value => 'Copy_Temp') .
" </td>" .
" </tr>" .
" <tr>" .
" <td>" .
$cgi->submit(-name => 'dialog', -value => 'View') .
" </td>" .
" </tr>" .
" </td>" .
" </table>" .
" </td>" .
" </table>" .
" </td>" .
"</table>" .
# Now the configuration part
"<br><br>" .
"<table> <caption>Configuration</caption>" .
"<td>" .
" <td>" .
$cgi->scrolling_list(
-name => 'configslist',
-value => [@configsarray],
-size => 10
) .
" </td>" .
" <td>" .
" <table>" .
" <tr><td>" .
$cgi->submit(-name => 'dialog', -value => 'New') .
" </td></tr>" .
" <tr><td>" .
$cgi->submit(-name => 'dialog', -value => 'Copy_Conf') .
" </td></tr>" .
" <tr><td>" .
$cgi->submit(-name => 'dialog', -value => 'Edit') .
" </td></tr>" .
" <tr><td>" .
$cgi->submit(-name => 'dialog', -value => 'Del') .
" </td></tr>" .
" <tr><td>" .
$cgi->submit(-name => 'dialog', -value => 'Run') .
" </td></tr>" .
" <tr><td>" .
$cgi->submit(-name => 'dialog', -value => 'Config_rights') .
" </td></tr>" .
" </table>" .
" </td>" .
"<td>" .
"</table>" ;
$page .= $cgi->endform;
}
elsif ($dialog eq 'Edit') {
# enter Edit form
$page .= &edit($cgi->param('configslist'));
}
elsif ($dialog eq 'View') {
# enter View form
$page .= &view($cgi->param('templatelist'));
}
elsif ($dialog eq 'New') {
$page .= $cgi->startform( -method => "POST", -action => $cgi->url(-full => 1));
$page .= &new($cfghash{'BaseDir'} . $cfghash{'ConfigDir'}, $username);
$page .= $cgi->endform;
}
elsif ($dialog eq 'New_file') {
$page .= $cgi->startform( -method => "POST", -action => $cgi->url(-full => 1));
$page .= &newfile($cfghash{'BaseDir'} . $cfghash{'ConfigDir'}, $username, $cgi->param('newfile'), $cgi->param('new_rights'));
$page .= $cgi->endform;
}
else {
die "invalid dialog \"$dialog\"";
}
} else {
die "no configuration found";
}
my $out = $MY->{TEMPLATE};
$out =~ s|%%BODY%%|$page|s;
$out =~ s|%%TITLE%%|Test|s;
print $cgi->header(-cookie => $cookies, -expires => '+1s') . $out;
exit (0);
########################################################################################
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_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 ($file) = @_;
my $text;
# enter Edit form
if($file) {
my $filename = $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $file;
&editconfig($filename, 'w', $username);
} else {
$text = $cgi->startform( -method => "POST", -action => $cgi->url(-full => 1)) .
"<font color=red>Missing filename<br><br>\n" .
$cgi->submit(-name => 'dialog', -value => 'Back') .
$cgi->endform;
}
return $text;
}
########################################################################################
########################################################################################
sub view {
########################################################################################
my ($file) = @_;
my $text;
if ($file) {
my $filename = $cfghash{'BaseDir'} . $cfghash{'ConfigDir'} . "/" . $cgi->param('templatelist');
&editconfig($filename, 'r', $username);
} else {
$text .= $cgi->startform( -method => "POST", -action => $cgi->url(-full => 1)) .
"<font color=red>Missing filename<br><br>\n" .
$cgi->submit(-name => 'dialog', -value => 'Back') .
$cgi->endform;
}
return $text;
}
########################################################################################
#########################################################################################
sub new {
########################################################################################
my ( $dirname, $user ) = @_;
my $text;
$text= "<font size=+2>" .
"New File:<br><br>\n" .
"</font>" .
"<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->checkbox_group(
# -name => 'new_rights',
# -values => ['private', 'protected', 'public'],
# -defaults => 'private',
# -linebreak => 'true'
# ) .
$cgi->scrolling_list(
-name => 'new_rights',
-value => ['private', 'protected', 'public'],
-size => 1
) .
" </td>" .
" </tr>" .
"<tr><td><br></td></tr>" .
" <tr>" .
"<td></td>" .
" <td colspan=2 align=left>" .
$cgi->submit(-name => 'dialog', -value => 'Back') .
$cgi->submit(-name => 'dialog', -value => 'New_file') .
" </td>" .
" </tr>" .
"</table>";
return $text;
}
########################################################################################
sub newfile {
########################################################################################
my ( $dirname, $user, $newfilename, $newrights ) = @_;
my $text;
my $newpath = $dirname . "/" . $user . "/" . $newfilename;
my $filerights = '';
$text= "<font size=+2>" .
"Creating New File:<br><br>" .
"</font><br><br><br>" ;
system("touch $newpath") && die "Cannot create new file";
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";
$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";
# Checking that file dont exist: TODO
$text .= "<br><br><br>" .
$cgi->submit(-name => 'dialog', -value => 'Back');
return $text;
}
########################################################################################
########################################################################################
sub read_config {
########################################################################################
my ($cfgfile) = @_;
my %cfghash ;
my $cfgin ;
my $key;
my $content;
print "Lese file: $cfgfile\n";
$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;
}
return (%cfghash);
}
########################################################################################
########################################################################################
sub validpassword {
########################################################################################
my ($username, $password) = @_;
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 =~ $username ) && 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"); # Open dir for scanning
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"); # Open dir for scanning
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 $text = '';
my $filein ;
my $readonly ;
my $titletext ;
$filein = IO::File->new("<$file");
while(<$filein>) { $text .= $_; }
$filein->close;
if ($mode eq 'w') {
$titletext = "Edit window";
} elsif ($mode eq 'r') {
$titletext = "View window";
}
my $textahash ={ -name => 'editwindow',
-default => $text,
-rows => 40,
-columns => 80
};
if ($mode eq 'r') {
$textahash->{readonly}="";
}
$page .= $cgi->startform( -method => "POST", -action => $cgi->url(-full => 1)) .
"<font size=+2>" .
$titletext . ": <br><br>\n" .
"</font>" .
"<font size=+1>" .
"File: $file<br><br>\n" .
"</font>" .
$cgi->textarea($textahash).
"<br><br>\n" .
"<table>" .
" <td>" .
" <td>" .
$cgi->submit(-name => 'dialog', -value => 'Back') .
" </td>";
if ($mode eq 'w') {
$page .= " <td>" .
$cgi->submit(-name => 'dialog', -value => 'Save') .
" </td>";
}
$page .= " <td>" .
" </td>" .
"</table>" .
$cgi->endform;
}
########################################################################################
