OSSP CVS Repository

ossp-pkg/tabea/tabea.cgi 1.6

---

#!/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;

$|++;

# 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)]);
    }
}

sub validpassword {
    my ($username, $password) = @_;
    return "";
}

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) || print STDOUT $cgi->redirect(-uri => $cgi->url(-full => 1), -type => "text/html");
    $page .= "Dialog:   ".$cgi->param("dialog") ."<br>\n";
    $page .= "Username: ".$cgi->param("username") ."<br>\n";
    $page .= "Password: ".$cgi->param("password") ."<br>\n";
}
elsif ($form eq 'select') {
    #   enter Edit form
    &validpassword($username, $password) || 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);

---