2008-12-03 17:05:27 +01:00
|
|
|
## @file
|
|
|
|
# Base package for all Lemonldap::NG CGI
|
|
|
|
|
|
|
|
## @class
|
2008-12-31 16:10:02 +01:00
|
|
|
# Base class for all Lemonldap::NG CGI
|
2008-11-20 07:53:44 +01:00
|
|
|
package Lemonldap::NG::Common::CGI;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
use strict;
|
|
|
|
|
|
|
|
use MIME::Base64;
|
|
|
|
use Time::Local;
|
|
|
|
use CGI;
|
2009-02-10 12:10:12 +01:00
|
|
|
|
2009-02-03 10:36:13 +01:00
|
|
|
#inherits Lemonldap::NG::Common::CGI::SOAPServer
|
2006-12-18 12:32:33 +01:00
|
|
|
|
2009-02-10 18:28:27 +01:00
|
|
|
our $VERSION = '0.4';
|
2006-12-18 12:32:33 +01:00
|
|
|
|
2008-12-04 14:53:05 +01:00
|
|
|
use base qw(CGI);
|
2006-12-18 12:32:33 +01:00
|
|
|
|
2009-02-12 20:48:53 +01:00
|
|
|
BEGIN {
|
|
|
|
if ( exists $ENV{MOD_PERL} ) {
|
|
|
|
if ( $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 ) {
|
|
|
|
eval 'use constant MP => 2;';
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
eval 'use constant MP => 1;';
|
|
|
|
}
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
eval 'use constant MP => 0;';
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
## @method void lmLog(string mess, string level)
|
|
|
|
# Log subroutine. Use Apache::Log in ModPerl::Registry context else simply
|
|
|
|
# print on STDERR non debug messages.
|
|
|
|
# @param $mess Text to log
|
|
|
|
# @param $level Level (debug|info|notice|error)
|
|
|
|
sub lmLog {
|
2009-02-14 09:55:19 +01:00
|
|
|
my ( $self, $mess, $level ) = @_;
|
|
|
|
$mess = ( ref($self) ? ref($self) : $self ) . ": $mess"
|
|
|
|
if ( $level eq 'debug' );
|
|
|
|
if ( $self->r and MP() ) {
|
|
|
|
if ( MP() == 2 ) {
|
2009-02-12 20:48:53 +01:00
|
|
|
require Apache2::Log;
|
|
|
|
Apache2::ServerRec->log->$level($mess);
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
Apache->server->log->$level($mess);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
else {
|
2009-02-14 09:55:19 +01:00
|
|
|
print STDERR "$mess\n" unless ( $level =~ /^(?:debug|info)$/ );
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
## @method void setApacheUser(string user)
|
|
|
|
# Set user for Apache logs in ModPerl::Registry context. Does nothing else.
|
|
|
|
# @param $user data to set as user in Apache logs
|
|
|
|
sub setApacheUser {
|
|
|
|
my ( $self, $user ) = @_;
|
|
|
|
if ( $self->r and MP() ) {
|
|
|
|
$self->lmLog( "Inform Apache about the user connected", 'debug' );
|
|
|
|
if ( MP() == 2 ) {
|
|
|
|
require Apache2::Connection;
|
|
|
|
$self->r->user($user);
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
$self->r->connection->user($user);
|
|
|
|
}
|
2009-02-12 20:48:53 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2009-02-05 18:05:18 +01:00
|
|
|
## @method void soapTest(string soapFunctions object obj)
|
2008-12-31 16:10:02 +01:00
|
|
|
# Check if request is a SOAP request. If it is, launch
|
|
|
|
# Lemonldap::NG::Common::CGI::SOAPServer and exit. Else simply return.
|
|
|
|
# @param $soapFunctions list of authorized functions.
|
2009-02-05 18:05:18 +01:00
|
|
|
# @param $obj optional object that will receive SOAP requests
|
2008-12-07 15:12:36 +01:00
|
|
|
sub soapTest {
|
2009-02-10 12:10:12 +01:00
|
|
|
my ( $self, $soapFunctions, $obj ) = @_;
|
2008-12-07 10:02:44 +01:00
|
|
|
|
|
|
|
# If non form encoded datas are posted, we call SOAP Services
|
2008-12-07 12:47:38 +01:00
|
|
|
if ( $ENV{HTTP_SOAPACTION} ) {
|
2009-02-10 12:10:12 +01:00
|
|
|
require
|
|
|
|
Lemonldap::NG::Common::CGI::SOAPServer; #link protected dispatcher
|
|
|
|
require
|
|
|
|
Lemonldap::NG::Common::CGI::SOAPService; #link protected soapService
|
|
|
|
my @func = (
|
|
|
|
ref($soapFunctions) ? @$soapFunctions : split /\s+/,
|
|
|
|
$soapFunctions
|
|
|
|
);
|
|
|
|
my $dispatcher =
|
|
|
|
Lemonldap::NG::Common::CGI::SOAPService->new( $obj || $self, @func );
|
2009-02-05 18:05:18 +01:00
|
|
|
Lemonldap::NG::Common::CGI::SOAPServer->dispatch_to($dispatcher)
|
2008-12-07 12:47:38 +01:00
|
|
|
->handle($self);
|
2008-12-07 10:02:44 +01:00
|
|
|
exit;
|
|
|
|
}
|
2006-12-18 12:32:33 +01:00
|
|
|
}
|
|
|
|
|
2008-12-31 16:10:02 +01:00
|
|
|
## @method string header_public(string filename)
|
|
|
|
# Implements the "304 Not Modified" HTTP mechanism.
|
|
|
|
# If HTTP request contains an "If-Modified-Since" header and if
|
|
|
|
# $filename was not modified since, prints the "304 Not Modified" response and
|
|
|
|
# exit. Else, launch CGI::header() with "Cache-Control" and "Last-Modified"
|
|
|
|
# headers.
|
|
|
|
# @param $filename Optional name of the reference file. Default
|
|
|
|
# $ENV{SCRIPT_FILENAME}.
|
|
|
|
# @return Common Gateway Interface standard response header
|
2006-12-18 12:32:33 +01:00
|
|
|
sub header_public {
|
2007-01-04 09:42:13 +01:00
|
|
|
my $self = shift;
|
2006-12-18 12:32:33 +01:00
|
|
|
my $filename = shift;
|
2006-12-23 16:42:58 +01:00
|
|
|
$filename ||= $ENV{SCRIPT_FILENAME};
|
2007-01-04 09:42:13 +01:00
|
|
|
my @tmp = stat($filename);
|
2006-12-18 12:32:33 +01:00
|
|
|
my $date = $tmp[9];
|
2007-01-04 09:42:13 +01:00
|
|
|
my $hd = gmtime($date);
|
|
|
|
$hd =~ s/^(\w+)\s+(\w+)\s+(\d+)\s+([\d:]+)\s+(\d+)$/$1, $3 $2 $5 $4 GMT/;
|
2006-12-18 12:32:33 +01:00
|
|
|
my $year = $5;
|
2007-01-04 09:42:13 +01:00
|
|
|
my $cm = $2;
|
|
|
|
|
2007-03-18 19:33:38 +01:00
|
|
|
# TODO: Remove TODO_ for stable releases
|
2008-12-05 17:30:27 +01:00
|
|
|
if ( my $ref = $ENV{HTTP_IF_MODIFIED_SINCE} ) {
|
2007-01-04 09:42:13 +01:00
|
|
|
my %month = (
|
|
|
|
jan => 0,
|
|
|
|
feb => 1,
|
|
|
|
mar => 2,
|
|
|
|
apr => 3,
|
|
|
|
may => 4,
|
|
|
|
jun => 5,
|
|
|
|
jul => 6,
|
|
|
|
aug => 7,
|
|
|
|
sep => 8,
|
|
|
|
oct => 9,
|
|
|
|
nov => 10,
|
|
|
|
dec => 11
|
|
|
|
);
|
|
|
|
if ( $ref =~ /^\w+,\s+(\d+)\s+(\w+)\s+(\d+)\s+(\d+):(\d+):(\d+)/ ) {
|
|
|
|
my $m = $month{ lc($2) };
|
|
|
|
$year-- if ( $m > $month{ lc($cm) } );
|
|
|
|
$ref = timegm( $6, $5, $4, $1, $m, $3 );
|
|
|
|
if ( $ref == $date ) {
|
|
|
|
print $self->SUPER::header( -status => '304 Not Modified', @_ );
|
|
|
|
exit;
|
|
|
|
}
|
|
|
|
}
|
2006-12-18 12:32:33 +01:00
|
|
|
}
|
2007-01-04 09:42:13 +01:00
|
|
|
return $self->SUPER::header(
|
|
|
|
'-Last-Modified' => $hd,
|
2008-12-05 17:30:27 +01:00
|
|
|
'-Cache-Control' => 'public; must-revalidate; max-age=1800',
|
2007-01-04 09:42:13 +01:00
|
|
|
@_
|
|
|
|
);
|
2006-12-18 12:32:33 +01:00
|
|
|
}
|
|
|
|
|
2008-12-31 16:10:02 +01:00
|
|
|
## @method void abort(string title, string text)
|
|
|
|
# Display an error message and exit.
|
|
|
|
# Used instead of die() in Lemonldap::NG CGIs.
|
|
|
|
# @param title Title of the error message
|
|
|
|
# @param text Optional text. Default: "See Apache's logs"
|
2008-11-21 08:27:08 +01:00
|
|
|
sub abort {
|
|
|
|
my $self = shift;
|
2008-12-07 10:02:44 +01:00
|
|
|
my $cgi = CGI->new;
|
2008-11-21 08:27:08 +01:00
|
|
|
my ( $t1, $t2 ) = @_;
|
|
|
|
$t2 ||= "See Apache's logs";
|
2009-02-10 12:10:12 +01:00
|
|
|
print $cgi->header( -type => 'text/html; charset=utf8', );
|
2008-11-21 08:27:08 +01:00
|
|
|
print $cgi->start_html(
|
|
|
|
-title => $t1,
|
|
|
|
-encoding => 'utf8',
|
|
|
|
);
|
|
|
|
print "<h1>$t1</h1>";
|
|
|
|
print "<p>$t2</p>";
|
2009-02-10 12:10:12 +01:00
|
|
|
print STDERR ( ref($self) || $self ) . " error: $t1, $t2\n";
|
2008-11-21 08:27:08 +01:00
|
|
|
exit;
|
|
|
|
}
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
1;
|
|
|
|
|
|
|
|
__END__
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
2008-11-20 07:53:44 +01:00
|
|
|
Lemonldap::NG::Common::CGI - Simple module to extend L<CGI> to manage
|
2006-12-18 12:32:33 +01:00
|
|
|
HTTP "If-Modified-Since / 304 Not Modified" system.
|
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
|
2008-11-20 07:53:44 +01:00
|
|
|
use Lemonldap::NG::Common::CGI;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
2008-11-20 07:53:44 +01:00
|
|
|
my $cgi = Lemonldap::NG::Common::CGI->new();
|
2006-12-18 12:32:33 +01:00
|
|
|
$cgi->header_public($ENV{SCRIPT_FILENAME});
|
|
|
|
print "<html><head><title>Static page</title></head>";
|
|
|
|
...
|
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
2008-11-20 07:53:44 +01:00
|
|
|
Lemonldap::NG::Common::CGI just add header_public subroutine to CGI module to
|
2006-12-18 12:32:33 +01:00
|
|
|
avoid printing HTML elements that can be cached.
|
|
|
|
|
|
|
|
=head1 METHODS
|
|
|
|
|
|
|
|
=head2 header_public
|
|
|
|
|
|
|
|
header_public works like header (see L<CGI>) but the first argument has to be
|
|
|
|
a filename: the last modify date of this file is used for reference.
|
|
|
|
|
|
|
|
=head2 EXPORT
|
|
|
|
|
|
|
|
=head1 SEE ALSO
|
|
|
|
|
2007-04-02 21:13:05 +02:00
|
|
|
L<Lemonldap::NG::Manager>, L<CGI>,
|
|
|
|
http://wiki.lemonldap.objectweb.org/xwiki/bin/view/NG/Presentation
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
|
|
|
|
Xavier Guimard, E<lt>x.guimard@free.frE<gt>
|
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
|
2007-03-18 19:33:38 +01:00
|
|
|
Copyright (C) 2006-2007 by Xavier Guimard E<lt>x.guimard@free.frE<gt>
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.8.4 or,
|
|
|
|
at your option, any later version of Perl 5 you may have available.
|
|
|
|
|
|
|
|
=cut
|