ossp-pkg/tabea/tabea.cgi
1.9
#!/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 $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);
};
# fetch parameters
my $form = $cgi->param("form") || "";
my $username = $cgi->param("username") || "";
my $password = $cgi->param("password") || "";
# 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)]);
}
}
my $page = '';
if ($form 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 ($form eq 'login') {
# enter Select form
&validpassword($username, $password, $pwdfile) || print STDOUT $cgi->redirect(-uri => $cgi->url(-full => 1), -type => "text/html");
my $templatesfiles = &readdir($configsdir."/".$tabeauser);
my $configsfiles = &readdir($configsdir."/".$username);
my @templateshash = split(/ /,$templatesfiles);
my $templateslist = "";
foreach (@templateshash) {
$templateslist .= "'$_', ";
}
# $templateslist .= "]";
#
$page .= $cgi->startform( -method => "POST", -action => $cgi->url(-full => 1)) .
$cgi->hidden(-name => 'form', -default => ['']) .
# Begin with templates part
$page .= "Templates: <br><br>\n" .
"<table width=70%>" .
" <td>" .
" <td>" .
$cgi->scrolling_list(
-name => 'templatelist',
-value => ['default', 'sample'],
-size => 2
) .
" </td>" .
" <td>" .
" <table>" .
" <td>" .
" <tr>" .
$cgi->submit(-name => 'copy', -value => 'Copy') .
" </tr>" .
" <tr>" .
$cgi->submit(-name => 'view', -value => 'View') .
" </tr>" .
" </td>" .
" </table>" .
" </td>" .
" </table>" .
" </td>" .
"</table>" .
# Now the configuration part
$page .= "Configuration: <br><br>\n".
"<table width=70%>" .
" <td>" .
" <td>" .
$cgi->scrolling_list(
-name => 'configlist',
-value => ['xdefault', 'xsample'],
-size => 5
) .
" </td>" .
" <td>" .
" <table>" .
" <td>" .
" <tr>" .
$cgi->submit(-name => 'new', -value => 'New') .
" </tr>" .
" <tr>" .
$cgi->submit(-name => 'copy', -value => 'Copy') .
" </tr>" .
" <tr>" .
$cgi->submit(-name => 'edit', -value => 'Edit') .
" </tr>" .
" <tr>" .
$cgi->submit(-name => 'del', -value => 'Del') .
" </tr>" .
" <tr>" .
$cgi->submit(-name => 'run', -value => 'Run') .
" </tr>" .
" <tr>" .
$cgi->submit(-name => 'conf_rights', -value => 'Config_rights') .
" </tr>" .
" </td>" .
" </table>" .
" </td>" .
" </td>" .
"</table>" .
$cgi->endform;
}
elsif ($form eq 'select') {
# enter Edit form
&validpassword($username, $password, $pwdfile) || print STDOUT $cgi->redirect(-uri => $cgi->url(-full => 1), -type => "text/html");
}
else {
die "invalid form \"$form\"";
}
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 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 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;
}
########################################################################################
