kalipso/racalmas
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

remove CGI where possible

Browse Source 
use mod_perl request with fallback to CGI::Simple where possible.
This commit is contained in:
Milan
2018-09-23 15:47:03 +02:00
parent 56881b92d0
commit 7ff41cecd2
42 changed files with 242 additions and 276 deletions
Download Patch File Download Diff File Expand all files Collapse all files

55
lib/calcms/auth.pm
View File

@@ -3,7 +3,7 @@ package auth;
use warnings "all";
use strict;
use CGI;
use CGI::Simple();
use CGI::Session qw(-ip-match);
use CGI::Cookie();
@@ -21,22 +21,24 @@ my $debug = 0;
sub debug;
#TODO: remove CGI
sub get_user {
my $cgi = shift;
my $config = shift;
my %parms = $cgi->Vars();
my $parms = \%parms;
my $params = shift;
my $cgi = shift;
debug("get_user") if ($debug);
# login or logout on action
if ( defined $parms->{action} ) {
if ( $parms->{action} eq 'login' ) {
my $user = login( $cgi, $config, $parms->{user}, $parms->{password} );
if ( defined $params->{action} ) {
if ( $params->{action} eq 'login' ) {
my $user = login( $config, $params->{user}, $params->{password} );
$cgi = new CGI::Simple() unless defined $cgi;
$cgi->delete( 'user', 'password', 'uri', 'action' );
return $user;
} elsif ( $parms->{action} eq 'logout' ) {
} elsif ( $params->{action} eq 'logout' ) {
$cgi = new CGI::Simple() unless defined $cgi;
logout($cgi);
$cgi->delete( 'user', 'password', 'uri', 'action' );
return undef;
@@ -44,20 +46,20 @@ sub get_user {
}
# read session id from cookie
my $session_id = read_cookie($cgi);
my $session_id = read_cookie();
# login if no cookie found
return show_login_form( $parms->{user}, 'Please login' ) unless defined $session_id;
return show_login_form( $params->{user}, 'Please login' ) unless defined $session_id;
# read session
my $session = read_session($session_id);
# login if user not found
return show_login_form( $parms->{user}, 'unknown User' ) unless defined $session;
return show_login_form( $params->{user}, 'unknown User' ) unless defined $session;
$parms->{user} = $session->{user};
$parms->{expires} = $session->{expires};
debug( $parms->{expires} );
$params->{user} = $session->{user};
$params->{expires} = $session->{expires};
debug( $params->{expires} );
return $session->{user}, $session->{expires};
}
@@ -76,7 +78,6 @@ sub crypt_password {
}
sub login {
my $cgi = shift;
my $config = shift;
my $user = shift;
my $password = shift;
@@ -94,13 +95,14 @@ sub login {
$timeout = '+' . $timeout . 'm';
my $session_id = create_session( $user, $password, $timeout );
return $user if ( create_cookie( $cgi, $session_id, $timeout ) );
return $user if create_cookie( $session_id, $timeout );
return undef;
}
#TODO: remove cgi
sub logout {
my $cgi = shift;
my $session_id = read_cookie($cgi);
my $session_id = read_cookie();
debug("logout") if ($debug);
unless ( delete_session($session_id) ) {
return show_login_form( 'Cant delete session', 'logged out' );
@@ -116,44 +118,34 @@ sub logout {
#read and write data from browser, http://perldoc.perl.org/CGI/Cookie.html
sub create_cookie {
my $cgi = shift;
my $session_id = shift;
my $timeout = shift;
#debug("create_cookie")if ($debug);
my $cookie = CGI::Cookie->new(
-name => 'sessionID',
-value => $session_id,
-expires => $timeout,
# -domain => '.capricorn.com',
# -path => '/agenda/admin/',
-secure => 1
-secure => 1
);
print "Set-Cookie: ", $cookie->as_string, "\n";
print STDERR "#Set-Cookie: ", $cookie->as_string, "\n";
# print $cgi->header( -cookie => $cookie );
return 1;
}
sub read_cookie {
my $cgi = shift;
debug("read_cookie") if ($debug);
my %cookie = CGI::Cookie->fetch;
debug( "cookies: " . Dumper( \%cookie ) ) if ($debug);
my $cookie = $cookie{'sessionID'};
debug( "cookie: " . $cookie ) if ($debug);
return undef unless defined $cookie ;
return undef unless defined $cookie;
my $session_id = $cookie->value || undef;
debug( "sid: " . $session_id ) if ($debug);
return $session_id;
#return $cgi->cookie('sessionID') || undef;
}
#TODO: remove CGI
sub delete_cookie {
my $cgi = shift;
@@ -179,7 +171,6 @@ sub create_session {
$session->param( "user", $user );
$session->param( "pid", $$ );
# $session->param("password", $password);
return $session->id();
}

6
lib/calcms/markup.pm
View File

@@ -7,6 +7,7 @@ use Text::WikiCreole();
use HTML::Parse();
use HTML::FormatText();
use Encode();
use HTML::Entities();
use log();
@@ -498,5 +499,10 @@ sub encode_xml_element_text {
return $text;
}
sub escapeHtml{
my $s=shift;
return HTML::Entities::encode_entities($s,q{&<>"'});
}
#do not delete last line!
1;

92
lib/calcms/params.pm
View File

@@ -4,79 +4,77 @@ use warnings "all";
use strict;
use Data::Dumper;
use CGI();
use Apache2::Request();
use base 'Exporter';
our @EXPORT_OK = qw(get isJson);
our @EXPORT_OK = qw(get isJson);
sub debug;
my $isJson = 0;
sub isJson {
return $isJson;
return $isJson;
}
sub get {
#get the Apache2::RequestRec
my $r = shift;
#get the Apache2::RequestRec
my $r = shift;
my $tmp_dir = '/var/tmp/';
my $upload_limit = 1000 * 1024;
my $tmp_dir = '/var/tmp/';
my $upload_limit = 1000 * 1024;
my $cgi = undef;
my $status = undef;
my $params = {};
my $cgi = undef;
my $status = undef;
my $params = {};
$isJson = 0;
$isJson = 0;
if ( defined $r ) {
if ( defined $r ) {
#print STDERR "Apache2::Request\n";
#get Apache2::Request
my $req = Apache2::Request->new( $r, POST_MAX => $upload_limit, TEMP_DIR => $tmp_dir );
#print STDERR "Apache2::Request\n";
#get Apache2::Request
my $req = Apache2::Request->new( $r, POST_MAX => $upload_limit, TEMP_DIR => $tmp_dir );
for my $key ( $req->param ) {
$params->{ scalar($key) } = scalar( $req->param($key) );
}
for my $key ( $req->param ) {
$params->{ scalar($key) } = scalar( $req->param($key) );
}
#copy params to hash
#my $body=$req->body();
#if (defined $body){
# for my $key (keys %$body){
# $params->{scalar($key)}=scalar($req->param($key));
# }
#}
$status = $req->parse; #parse
} else {
#copy params to hash
#my $body=$req->body();
#if (defined $body){
# for my $key (keys %$body){
# $params->{scalar($key)}=scalar($req->param($key));
# }
#}
$status = $req->parse; #parse
} else {
print STDERR "$0: require CGI\n";
require "CGI.pm";
$CGI::POST_MAX = $upload_limit;
$CGI::TMPDIRECTORY = $tmp_dir;
$cgi = new CGI();
$status = $cgi->cgi_error() || $status;
my %params = $cgi->Vars();
$params = \%params;
}
#print STDERR "CGI\n";
$CGI::POST_MAX = $upload_limit;
$CGI::TMPDIRECTORY = $tmp_dir;
$cgi = new CGI();
$status = $cgi->cgi_error() || $status;
my %params = $cgi->Vars();
$params = \%params;
}
$cgi = new CGI() unless ( defined $cgi );
$isJson = 1 if ( defined $params->{json} ) && ( $params->{json} eq '1' );
$isJson = 1 if ( defined $params->{json} ) && ( $params->{json} eq '1' );
if ( defined $status ) {
$status = '' if ( $status eq 'Success' );
$status = '' if ( $status eq 'Missing input data' );
print $cgi->header . $status . "\n" if ( $status ne '' );
}
if ( defined $status ) {
$status = '' if ( $status eq 'Success' );
$status = '' if ( $status eq 'Missing input data' );
print $cgi->header . $status . "\n" if ( $status ne '' );
}
#print STDERR Dumper($params);
#print $cgi->header.Dumper($params).$status;
#print STDERR Dumper($params);
#print $cgi->header.Dumper($params).$status;
return ( $cgi, $params, $status );
return ( $cgi, $params, $status );
}
sub debug {
my $message = shift;
my $message = shift;
}
#do not delete last line!

1
lib/calcms/uac.pm
View File

@@ -2,7 +2,6 @@ package uac;
use warnings "all";
use strict;
use CGI();
use CGI::Session qw(-ip-match);
use CGI::Cookie();
use Data::Dumper;