devel - Re: [sympa-developpers] [sympa-commits] sympa[10085] trunk: [dev] move all perl modules in the same src/ lib directory

Subject: Developers of Sympa

List archive

Re: [sympa-developpers] [sympa-commits] sympa[10085] trunk: [dev] move all perl modules in the same src/ lib directory

From: IKEDA Soji <address@concealed>
To: address@concealed
Subject: Re: [sympa-developpers] [sympa-commits] sympa[10085] trunk: [dev] move all perl modules in the same src/ lib directory
Date: Thu, 2 Jan 2014 21:18:07 +0900

Dear developers,

In the last days of the last year, I replayed commits on
sympa-6.1-branch which were rollbacked in sympa-6.2-branch.
Because, I beleived bugs may be fixed in curent release branch
anyway.

Afterward, I planned to merge some reordering and renaming
in sympa-cleanup branch to current sympa-6.2-branch.
Attached is my plan to do it (OpenOffice/LibreOffice Spleadsheet
format).

Regards.

-- Soji

On Thu, 2 Jan 2014 20:39:13 +0900
IKEDA Soji <address@concealed> wrote:

> All,
>
> A happy new year!
>
>
> And Guillaume.
>
> Stop.
>
> Before you move files, please talk us your plan of refactoring.
> I have some proposal to your works on sympa-cleanup brahch.
>
> But unfortunately, I'm in new year vacation (in Japan, a few days
> before and after arrival of new year, all works in the country
> stops). Please give me a few days to respond you.
>
> Celebrating new year for Sympa,
>
> -- Soji
>
> On Thu, 2 Jan 2014 10:16:17 +0100 (CET)
> address@concealed wrote:
>
> > sympa[10085] trunk: [dev] move all perl modules in the same src/lib
> > directory
> > Revision 10085 Author rousse Date 2014-01-02 10:16:17 +0100 (jeu. 02
> > janv. 2014)
> > Log Message[dev] move all perl modules in the same src/lib directory
> > Modified Paths
> > trunk/po/POTFILES.in
> > trunk/src/lib/Makefile.am
> > trunk/wwsympa/Makefile.am
> > Added Paths
> > trunk/src/lib/Auth.pm
> > trunk/src/lib/Challenge.pm
> > trunk/src/lib/Marc/
> > trunk/src/lib/Marc.pm
> > trunk/src/lib/SharedDocument.pm
> > trunk/src/lib/SympaSession.pm
> > trunk/src/lib/cookielib.pm
> > trunk/src/lib/wwslib.pm
> > Removed Paths
> > trunk/wwsympa/Auth.pm
> > trunk/wwsympa/Challenge.pm
> > trunk/wwsympa/Marc/
> > trunk/wwsympa/Marc.pm
> > trunk/wwsympa/SharedDocument.pm
> > trunk/wwsympa/SympaSession.pm
> > trunk/wwsympa/cookielib.pm
> > trunk/wwsympa/wwslib.pm
> > Diff
> > Modified: trunk/po/POTFILES.in (10084 => 10085)
> > --- trunk/po/POTFILES.in 2014-01-02 09:09:01 UTC (rev 10084)
> > +++ trunk/po/POTFILES.in 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -288,12 +288,12 @@
> > web_tt2/view_template.tt2
> > web_tt2/your_lists.tt2
> > wwsympa/archived.pl.in
> > -wwsympa/Auth.pm
> > +src/lib/Auth.pm
> > wwsympa/bounced.pl.in
> > #wwsympa/Challenge.pm
> > -wwsympa/cookielib.pm
> > -wwsympa/Marc.pm
> > -wwsympa/SharedDocument.pm
> > -wwsympa/SympaSession.pm
> > -wwsympa/wwslib.pm
> > +src/lib/cookielib.pm
> > +src/lib/Marc.pm
> > +src/lib/SharedDocument.pm
> > +src/lib/SympaSession.pm
> > +src/lib/wwslib.pm
> > wwsympa/wwsympa.fcgi.in
> > Copied: trunk/src/lib/Auth.pm (from rev 10083, trunk/wwsympa/Auth.pm) (0
> > => 10085)
> > --- trunk/src/lib/Auth.pm (rev 0)
> > +++ trunk/src/lib/Auth.pm 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -0,0 +1,575 @@
> > +# Auth.pm - This module provides web authentication functions
> > +# RCS Identication ; $Revision$ ; $Date$
> > +#
> > +# Sympa - SYsteme de Multi-Postage Automatique
> > +# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des
> > Universites
> > +# Copyright (c) 1997,1998, 1999 Institut Pasteur & Christophe Wolfhugel
> > +#
> > +# This program is free software; you can redistribute it and/or modify
> > +# it under the terms of the GNU General Public License as published by
> > +# the Free Software Foundation; either version 2 of the License, or
> > +# (at your option) any later version.
> > +#
> > +# This program is distributed in the hope that it will be useful,
> > +# but WITHOUT ANY WARRANTY; without even the implied warranty of
> > +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> > +# GNU General Public License for more details.
> > +#
> > +# You should have received a copy of the GNU General Public License
> > +# along with this program. If not, see <http://www.gnu.org/licenses/>.
> > +
> > +package Auth;
> > +
> > +use Digest::MD5;
> > +
> > +use Language qw(gettext_strftime);
> > +
> > +#use Log;
> > +#use Conf;
> > +#use List; # not used
> > +use report;
> > +
> > +#use SDM;
> > +
> > +## return the password finger print (this proc allow futur replacement
> > of md5 by sha1 or ....)
> > +sub password_fingerprint {
> > +
> > + Sympa::Log::Syslog::do_log('debug', 'Auth::password_fingerprint');
> > +
> > + my $pwd = shift;
> > + if (Site->password_case eq 'insensitive') {
> > + return &tools::md5_fingerprint(lc($pwd));
> > + } else {
> > + return &tools::md5_fingerprint($pwd);
> > + }
> > +}
> > +
> > +## authentication : via email or uid
> > +sub check_auth {
> > + Sympa::Log::Syslog::do_log('debug2', '(%s, %s, ...)', @_);
> > + my $robot = Robot::clean_robot(shift);
> > + my $auth = shift; ## User email or UID
> > + my $pwd = shift; ## Password
> > +
> > + my ($canonic, $user);
> > +
> > + if (&tools::valid_email($auth)) {
> > + return authentication($robot, $auth, $pwd);
> > + } else {
> > + ## This is an UID
> > + foreach my $ldap (@{Site->auth_services->{$robot->domain}}) {
> > +
> > + # only ldap service are to be applied here
> > + next unless ($ldap->{'auth_type'} eq 'ldap');
> > +
> > + $canonic =
> > + ldap_authentication($robot, $ldap, $auth, $pwd, 'uid_filter');
> > + last if ($canonic); ## Stop at first match
> > + }
> > + if ($canonic) {
> > +
> > + unless ($user = User::get_global_user($canonic)) {
> > + $user = {'email' => $canonic};
> > + }
> > + return {
> > + 'user' => $user,
> > + 'auth' => 'ldap',
> > + 'alt_emails' => {$canonic => 'ldap'}
> > + };
> > +
> > + } else {
> > + &report::reject_report_web('user', 'incorrect_passwd', {})
> > + unless ($ENV{'SYMPA_SOAP'});
> > + Sympa::Log::Syslog::do_log('err', "Incorrect LDAP password");
> > + return undef;
> > + }
> > + }
> > +}
> > +
> > +## This subroutine if Sympa may use its native authentication for a
> > given user
> > +## It might not if no user_table paragraph is found in auth.conf or if
> > the regexp or
> > +## negative_regexp exclude this user
> > +## IN : robot, user email
> > +## OUT : boolean
> > +sub may_use_sympa_native_auth {
> > + my $robot = Robot::clean_robot(shift);
> > + my $user_email = shift;
> > +
> > + my $ok = 0;
> > + ## check each auth.conf paragrpah
> > + foreach my $auth_service (@{Site->auth_services->{$robot->domain}}) {
> > + next unless ($auth_service->{'auth_type'} eq 'user_table');
> > +
> > + next
> > + if ($auth_service->{'regexp'} &&
> > + ($user_email !~ /$auth_service->{'regexp'}/i));
> > + next
> > + if ($auth_service->{'negative_regexp'} &&
> > + ($user_email =~ /$auth_service->{'negative_regexp'}/i));
> > +
> > + $ok = 1;
> > + last;
> > + }
> > +
> > + return $ok;
> > +}
> > +
> > +sub authentication {
> > + Sympa::Log::Syslog::do_log('debug2', '(%s, %s, ...)', @_);
> > + my $robot = Robot::clean_robot(shift);
> > + my $email = shift;
> > + my $pwd = shift;
> > + my ($user, $canonic);
> > +
> > + unless ($user = User::get_global_user($email)) {
> > + $user = {'email' => $email};
> > + }
> > + unless ($user->{'password'}) {
> > + $user->{'password'} = '';
> > + }
> > +
> > + if ($user->{'wrong_login_count'} > $robot->max_wrong_password) {
> > +
> > + # too many wrong login attemp
> > + User::update_global_user($email,
> > + {wrong_login_count => $user->{'wrong_login_count'} + 1});
> > + &report::reject_report_web('user', 'too_many_wrong_login', {})
> > + unless ($ENV{'SYMPA_SOAP'});
> > + Sympa::Log::Syslog::do_log('err',
> > + 'login is blocked : too many wrong password submission for %s',
> > + $email);
> > + return undef;
> > + }
> > + foreach my $auth_service (@{Site->auth_services->{$robot->domain}}) {
> > + next if ($auth_service->{'auth_type'} eq 'authentication_info_url');
> > + next if ($email !~ /$auth_service->{'regexp'}/i);
> > + next
> > + if (($email =~ /$auth_service->{'negative_regexp'}/i) &&
> > + ($auth_service->{'negative_regexp'}));
> > +
> > + ## Only 'user_table' and 'ldap' backends will need that Sympa
> > collects the user passwords
> > + ## Other backends are Single Sign-On solutions
> > + if ($auth_service->{'auth_type'} eq 'user_table') {
> > + my $fingerprint = &password_fingerprint($pwd);
> > +
> > + if ($fingerprint eq $user->{'password'}) {
> > + User::update_global_user($email, {wrong_login_count => 0});
> > + return {
> > + 'user' => $user,
> > + 'auth' => 'classic',
> > + 'alt_emails' => {$email => 'classic'}
> > + };
> > + }
> > + } elsif ($auth_service->{'auth_type'} eq 'ldap') {
> > + if ($canonic = ldap_authentication(
> > + $robot, $auth_service, $email, $pwd, 'email_filter'
> > + )
> > + ) {
> > + unless ($user = User::get_global_user($canonic)) {
> > + $user = {'email' => $canonic};
> > + }
> > + User::update_global_user($canonic, {wrong_login_count => 0});
> > + return {
> > + 'user' => $user,
> > + 'auth' => 'ldap',
> > + 'alt_emails' => {$email => 'ldap'}
> > + };
> > + }
> > + }
> > + }
> > +
> > + # increment wrong login count.
> > + User::update_global_user($email,
> > + {wrong_login_count => $user->{'wrong_login_count'} + 1});
> > +
> > + &report::reject_report_web('user', 'incorrect_passwd', {})
> > + unless ($ENV{'SYMPA_SOAP'});
> > + Sympa::Log::Syslog::do_log('err', 'authentication: incorrect
> > password for user %s',
> > + $email);
> > +
> > + $param->{'init_email'} = $email;
> > + $param->{'escaped_init_email'} = &tools::escape_chars($email);
> > + return undef;
> > +}
> > +
> > +sub ldap_authentication {
> > + Sympa::Log::Syslog::do_log('debug2', '(%s, %s, %s, ...)', @_);
> > + my $robot = Robot::clean_robot(shift);
> > + my $ldap = shift;
> > + my $auth = shift;
> > + my $pwd = shift;
> > + my $whichfilter = shift;
> > + my ($mesg, $host, $ldap_passwd, $ldap_anonymous);
> > +
> > + unless ($robot->get_etc_filename('auth.conf')) {
> > + return undef;
> > + }
> > +
> > + ## No LDAP entry is defined in auth.conf
> > + if ($#{Site->auth_services->{$robot->domain}} < 0) {
> > + Sympa::Log::Syslog::do_log('notice', 'Skipping empty auth.conf');
> > + return undef;
> > + }
> > +
> > + # only ldap service are to be applied here
> > + return undef unless ($ldap->{'auth_type'} eq 'ldap');
> > +
> > + # skip ldap auth service if the an email address was provided
> > + # and this email address does not match the corresponding regexp
> > + return undef if ($auth =~ /@/ && $auth !~ /$ldap->{'regexp'}/i);
> > +
> > + my @alternative_conf = split(/,/,
> > $ldap->{'alternative_email_attribute'});
> > + my $attrs = $ldap->{'email_attribute'};
> > + my $filter = $ldap->{'get_dn_by_uid_filter'}
> > + if ($whichfilter eq 'uid_filter');
> > + $filter = $ldap->{'get_dn_by_email_filter'}
> > + if ($whichfilter eq 'email_filter');
> > + $filter =~ s/\[sender\]/$auth/ig;
> > +
> > + ## bind in order to have the user's DN
> > + my $param = &tools::dup_var($ldap);
> > + my $ds = new LDAPSource($param);
> > +
> > + unless (defined $ds && ($ldap_anonymous = $ds->connect())) {
> > + Sympa::Log::Syslog::do_log('err', "Unable to connect to the LDAP
> > server '%s'",
> > + $ldap->{'host'});
> > + return undef;
> > + }
> > +
> > + $mesg = $ldap_anonymous->search(
> > + base => $ldap->{'suffix'},
> > + filter => "$filter",
> > + scope => $ldap->{'scope'},
> > + timeout => $ldap->{'timeout'}
> > + );
> > +
> > + if ($mesg->count() == 0) {
> > + Sympa::Log::Syslog::do_log('notice',
> > + 'No entry in the Ldap Directory Tree of %s for %s',
> > + $ldap->{'host'}, $auth);
> > + $ds->disconnect();
> > + return undef;
> > + }
> > +
> > + my $refhash = $mesg->as_struct();
> > + my (@DN) = keys(%$refhash);
> > + $ds->disconnect();
> > +
> > + ## bind with the DN and the pwd
> > +
> > + ## Duplicate structure first
> > + ## Then set the bind_dn and password according to the current user
> > + $param = &tools::dup_var($ldap);
> > + $param->{'ldap_bind_dn'} = $DN[0];
> > + $param->{'ldap_bind_password'} = $pwd;
> > +
> > + $ds = new LDAPSource($param);
> > +
> > + unless (defined $ds && ($ldap_passwd = $ds->connect())) {
> > + Sympa::Log::Syslog::do_log('err', "Unable to connect to the LDAP
> > server '%s'",
> > + $param->{'host'});
> > + return undef;
> > + }
> > +
> > + $mesg = $ldap_passwd->search(
> > + base => $ldap->{'suffix'},
> > + filter => "$filter",
> > + scope => $ldap->{'scope'},
> > + timeout => $ldap->{'timeout'}
> > + );
> > +
> > + if ($mesg->count() == 0 || $mesg->code() != 0) {
> > + Sympa::Log::Syslog::do_log('notice', "No entry in the LDAP Directory
> > Tree of %s",
> > + $ldap->{'host'});
> > + $ds->disconnect();
> > + return undef;
> > + }
> > +
> > + ## To get the value of the canonic email and the alternative email
> > + my (@canonic_email, @alternative);
> > +
> > + ## Keep previous alt emails not from LDAP source
> > + my $previous = {};
> > + foreach my $alt (keys %{$param->{'alt_emails'}}) {
> > + $previous->{$alt} = $param->{'alt_emails'}{$alt}
> > + if ($param->{'alt_emails'}{$alt} ne 'ldap');
> > + }
> > + $param->{'alt_emails'} = {};
> > +
> > + my $entry = $mesg->entry(0);
> > + @canonic_email = $entry->get_value($attrs, 'alloptions' => 1);
> > + foreach my $email (@canonic_email) {
> > + my $e = lc($email);
> > + $param->{'alt_emails'}{$e} = 'ldap' if ($e);
> > + }
> > +
> > + foreach my $attribute_value (@alternative_conf) {
> > + @alternative = $entry->get_value($attribute_value, 'alloptions' => 1);
> > + foreach my $alter (@alternative) {
> > + my $a = lc($alter);
> > + $param->{'alt_emails'}{$a} = 'ldap' if ($a);
> > + }
> > + }
> > +
> > + ## Restore previous emails
> > + foreach my $alt (keys %{$previous}) {
> > + $param->{'alt_emails'}{$alt} = $previous->{$alt};
> > + }
> > +
> > + $ds->disconnect() or Sympa::Log::Syslog::do_log('notice', "unable to
> > unbind");
> > + Sympa::Log::Syslog::do_log('debug3', "canonic: $canonic_email[0]");
> > + ## If the identifier provided was a valid email, return the provided
> > email.
> > + ## Otherwise, return the canonical email guessed after the login.
> > + if (&tools::valid_email($auth) &&
> > !$robot->ldap_force_canonical_email) {
> > + return ($auth);
> > + } else {
> > + return lc($canonic_email[0]);
> > + }
> > +}
> > +
> > +# fetch user email using his cas net_id and the paragrapah number in
> > auth.conf
> > +## NOTE: This might be moved to Robot package.
> > +sub get_email_by_net_id {
> > + my $robot = Robot::clean_robot(shift);
> > + my $auth_id = shift;
> > + my $attributes = shift;
> > + Sympa::Log::Syslog::do_log('debug2', '(%s, %s, uid=%s)',
> > + $robot, $auth_id, $attributes->{'uid'});
> > +
> > + if (defined Site->auth_services->{$robot->domain}[$auth_id]
> > + {'internal_email_by_netid'}) {
> > + my $sso_config = @{Site->auth_services->{$robot->domain}}[$auth_id];
> > + my $netid_cookie = $sso_config->{'netid_http_header'};
> > +
> > + $netid_cookie =~ s/(\w+)/$attributes->{$1}/ig;
> > +
> > + $email =
> > + $robot->get_netidtoemail_db($netid_cookie,
> > + Site->auth_services->{$robot->domain}[$auth_id]{'service_id'});
> > +
> > + return $email;
> > + }
> > +
> > + my $ldap = @{Site->auth_services->{$robot->domain}}[$auth_id];
> > +
> > + my $param = &tools::dup_var($ldap);
> > + my $ds = new LDAPSource($param);
> > + my $ldap_anonymous;
> > +
> > + unless (defined $ds && ($ldap_anonymous = $ds->connect())) {
> > + Sympa::Log::Syslog::do_log('err', "Unable to connect to the LDAP
> > server '%s'",
> > + $ldap->{'ldap_host'});
> > + return undef;
> > + }
> > +
> > + my $filter = $ldap->{'ldap_get_email_by_uid_filter'};
> > + $filter =~ s/\[([\w-]+)\]/$attributes->{$1}/ig;
> > +
> > + # my @alternative_conf =
> > split(/,/,$ldap->{'alternative_email_attribute'});
> > +
> > + my $emails = $ldap_anonymous->search(
> > + base => $ldap->{'ldap_suffix'},
> > + filter => $filter,
> > + scope => $ldap->{'ldap_scope'},
> > + timeout => $ldap->{'ldap_timeout'},
> > + attrs => [$ldap->{'ldap_email_attribute'}],
> > + );
> > + my $count = $emails->count();
> > +
> > + if ($emails->count() == 0) {
> > + Sympa::Log::Syslog::do_log('notice', "No entry in the LDAP Directory
> > Tree of %s",
> > + $host);
> > + $ds->disconnect();
> > + return undef;
> > + }
> > +
> > + $ds->disconnect();
> > +
> > + ## return only the first attribute
> > + my @results = $emails->entries;
> > + foreach my $result (@results) {
> > + return (lc($result->get_value($ldap->{'ldap_email_attribute'})));
> > + }
> > +
> > +}
> > +
> > +# check trusted_application_name et trusted_application_password :
> > return 1 or undef;
> > +sub remote_app_check_password {
> > + my $trusted_application_name = shift;
> > + my $password = shift;
> > + my $robot = Robot::clean_robot(shift);
> > + Sympa::Log::Syslog::do_log('debug2', '(%s, ..., %s)',
> > $trusted_application_name, $robot);
> > +
> > + my $md5 = &tools::md5_fingerprint($password);
> > +
> > + my $vars;
> > +
> > + # seach entry for trusted_application in Conf
> > + my @trusted_apps;
> > +
> > + # select trusted_apps from robot context or sympa context
> > + @trusted_apps = @{$robot->trusted_applications};
> > +
> > + foreach my $application (@trusted_apps) {
> > +
> > + if (lc($application->{'name'}) eq lc($trusted_application_name)) {
> > + if ($md5 eq $application->{'md5password'}) {
> > +
> > +# Sympa::Log::Syslog::do_log('debug', 'Auth::remote_app_check_password :
> > authentication succeed for %s',$application->{'name'});
> > + my %proxy_for_vars;
> > + foreach my $varname (@{$application->{'proxy_for_variables'}})
> > + {
> > + $proxy_for_vars{$varname} = 1;
> > + }
> > + return (\%proxy_for_vars);
> > + } else {
> > + Sympa::Log::Syslog::do_log('info',
> > + 'Auth::remote_app_check_password: bad password from %s',
> > + $trusted_application_name);
> > + return undef;
> > + }
> > + }
> > + }
> > +
> > + # no matching application found
> > + Sympa::Log::Syslog::do_log('info',
> > + 'Auth::remote_app-check_password: unknown application name %s',
> > + $trusted_application_name);
> > + return undef;
> > +}
> > +
> > +# create new entry in one_time_ticket table using a rand as id so later
> > +# access is authenticated
> > +sub create_one_time_ticket {
> > + Sympa::Log::Syslog::do_log('debug2', '(%s, %s, %s, %s)', @_);
> > + my $email = shift;
> > + my $robot = Robot::clean_robot(shift);
> > + my $data_string = shift;
> > + my $remote_addr = shift;
> > + ## Value may be 'mail' if the IP address is not known
> > +
> > + my $ticket = &SympaSession::get_random();
> > +
> > + my $date = time;
> > + my $sth;
> > +
> > + unless (
> > + SDM::do_prepared_query(
> > + q{INSERT INTO one_time_ticket_table
> > + (ticket_one_time_ticket, robot_one_time_ticket,
> > + email_one_time_ticket, date_one_time_ticket, data_one_time_ticket,
> > + remote_addr_one_time_ticket, status_one_time_ticket)
> > + VALUES (?, ?, ?, ?, ?, ?, ?)},
> > + $ticket, $robot->domain,
> > + $email, time, $data_string,
> > + $remote_addr, 'open'
> > + )
> > + ) {
> > + Sympa::Log::Syslog::do_log(
> > + 'err',
> > + 'Unable to insert new one time ticket for user %s, robot %s in
> > the database',
> > + $email,
> > + $robot
> > + );
> > + return undef;
> > + }
> > + return $ticket;
> > +}
> > +
> > +# read one_time_ticket from table and remove it
> > +sub get_one_time_ticket {
> > + Sympa::Log::Syslog::do_log('debug2', '(%s, %s)', @_);
> > + my $robot = shift;
> > + my $ticket_number = shift;
> > + my $addr = shift;
> > +
> > + my $sth;
> > +
> > + unless (
> > + $sth = SDM::do_prepared_query(
> > + q{SELECT ticket_one_time_ticket AS ticket,
> > + robot_one_time_ticket AS robot,
> > + email_one_time_ticket AS email,
> > + date_one_time_ticket AS "date",
> > + data_one_time_ticket AS data,
> > + remote_addr_one_time_ticket AS remote_addr,
> > + status_one_time_ticket as status
> > + FROM one_time_ticket_table
> > + WHERE ticket_one_time_ticket = ? AND robot_one_time_ticket = ?},
> > + $ticket_number, $robot->domain
> > + )
> > + ) {
> > + Sympa::Log::Syslog::do_log('err',
> > + 'Unable to retrieve one time ticket %s from database',
> > + $ticket_number);
> > + return {'result' => 'error'};
> > + }
> > +
> > + my $ticket = $sth->fetchrow_hashref('NAME_lc');
> > + $sth->finish;
> > +
> > + unless ($ticket) {
> > + Sympa::Log::Syslog::do_log('info', 'Unable to find one time ticket
> > %s', $ticket);
> > + return {'result' => 'not_found'};
> > + }
> > +
> > + my $result;
> > + my $printable_date = gettext_strftime "%d %b %Y at %H:%M:%S",
> > + localtime($ticket->{'date'});
> > + my $lockout = $robot->one_time_ticket_lockout || 'open';
> > + my $lifetime =
> > + tools::duration_conv($robot->one_time_ticket_lifetime || 0);
> > +
> > + if ($lockout eq 'one_time' and $ticket->{'status'} ne 'open') {
> > + $result = 'closed';
> > + Sympa::Log::Syslog::do_log('info', 'ticket %s from %s has been used
> > before (%s)',
> > + $ticket_number, $ticket->{'email'}, $printable_date);
> > + } elsif ($lockout eq 'remote_addr' and
> > + $ticket->{'status'} ne $addr and
> > + $ticket->{'status'} ne 'open') {
> > + $result = 'closed';
> > + Sympa::Log::Syslog::do_log('info',
> > + 'ticket %s from %s refused because accessed by the other (%s)',
> > + $ticket_number, $ticket->{'email'}, $printable_date);
> > + } elsif ($lifetime and $ticket->{'date'} + $lifetime < time) {
> > + Sympa::Log::Syslog::do_log('info', 'ticket %s from %s refused because
> > expired (%s)',
> > + $ticket_number, $ticket->{'email'}, $printable_date);
> > + $result = 'expired';
> > + } else {
> > + $result = 'success';
> > + }
> > +
> > + if ($result eq 'success') {
> > + unless (
> > + $sth = SDM::do_prepared_query(
> > + q{UPDATE one_time_ticket_table
> > + SET status_one_time_ticket = ?
> > + WHERE ticket_one_time_ticket = ? AND robot_one_time_ticket = ?},
> > + $addr, $ticket_number, $robot->domain
> > + )
> > + ) {
> > + Sympa::Log::Syslog::do_log('err',
> > + 'Unable to set one time ticket %s status to %s',
> > + $ticket_number, $addr);
> > + } elsif (!$sth->rows) {
> > +
> > + # ticket may be removed by task.
> > + Sympa::Log::Syslog::do_log('info', 'Unable to find one time
> > ticket %s',
> > + $ticket_number);
> > + return {'result' => 'not_found'};
> > + }
> > + }
> > +
> > + Sympa::Log::Syslog::do_log('debug', 'ticket : %s; result : %s',
> > $ticket_number, $result);
> > + return {
> > + 'result' => $result,
> > + 'date' => $ticket->{'date'},
> > + 'email' => $ticket->{'email'},
> > + 'remote_addr' => $ticket->{'remote_addr'},
> > + 'robot' => $robot->domain,
> > + 'data' => $ticket->{'data'},
> > + 'status' => $ticket->{'status'}
> > + };
> > +}
> > +
> > +1;
> > Copied: trunk/src/lib/Challenge.pm (from rev 10083,
> > trunk/wwsympa/Challenge.pm) (0 => 10085)
> > --- trunk/src/lib/Challenge.pm (rev 0)
> > +++ trunk/src/lib/Challenge.pm 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -0,0 +1,135 @@
> > +# Challenge.pm - This module includes functions managing email challenges
> > +#
> > +# Sympa - SYsteme de Multi-Postage Automatique
> > +# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des
> > Universites
> > +# Copyright (c) 1997,1998, 1999 Institut Pasteur & Christophe Wolfhugel
> > +#
> > +# This program is free software; you can redistribute it and/or modify
> > +# it under the terms of the GNU General Public License as published by
> > +# the Free Software Foundation; either version 2 of the License, or
> > +# (at your option) any later version.
> > +#
> > +# This program is distributed in the hope that it will be useful,
> > +# but WITHOUT ANY WARRANTY; without even the implied warranty of
> > +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> > +# GNU General Public License for more details.
> > +#
> > +# You should have received a copy of the GNU General Public License
> > +# along with this program. If not, see <http://www.gnu.org/licenses/>.
> > +
> > +package Challenge;
> > +
> > +use strict;
> > +no strict "vars";
> > +
> > +use Digest::MD5;
> > +use POSIX;
> > +use CGI::Cookie;
> > +use Time::Local;
> > +
> > +use Log;
> > +use Conf;
> > +use SympaSession;
> > +use SDM;
> > +
> > +# this structure is used to define which session attributes are stored
> > in a dedicated database col where others are compiled in col
> > 'data_session'
> > +my %challenge_hard_attributes = ('id_challenge' => 1, 'date' => 1,
> > 'robot' => 1,'email' => 1, 'list' => 1);
> > +
> > +
> > +# create a challenge context and store it in challenge table
> > +sub create {
> > + my ($robot, $email, $context) = @_;
> > +
> > + Sympa::Log::Syslog::do_log('debug', 'Challenge::new(%s, %s, %s)',
> > $challenge_id, $email, $robot);
> > +
> > + my $challenge={};
> > +
> > + unless ($robot) {
> > + Sympa::Log::Syslog::do_log('err', 'Missing robot parameter, cannot
> > create challenge object') ;
> > + return undef;
> > + }
> > +
> > + unless ($email) {
> > + Sympa::Log::Syslog::do_log('err', 'Missing email parameter, cannot
> > create challenge object') ;
> > + return undef;
> > + }
> > +
> > + $challenge->{'id_challenge'} = &get_random();
> > + $challenge->{'email'} = $email;
> > + $challenge->{'date'} = time;
> > + $challenge->{'robot'} = $robot;
> > + $challenge->{'data'} = $context;
> > + return undef unless (&Challenge::store($challenge));
> > + return $challenge->{'id_challenge'}
> > +}
> > +
> > +
> > +
> > +sub load {
> > +
> > + my $id_challenge = shift;
> > +
> > + Sympa::Log::Syslog::do_log('debug', 'Challenge::load(%s)',
> > $id_challenge);
> > +
> > + unless ($challenge_id) {
> > + Sympa::Log::Syslog::do_log('err', 'Challenge::load() : internal
> > error, SympaSession::load called with undef id_challenge');
> > + return undef;
> > + }
> > +
> > + my $sth;
> > +
> > + unless($sth = &SDM::do_query("SELECT id_challenge AS id_challenge,
> > date_challenge AS 'date', remote_addr_challenge AS remote_addr,
> > robot_challenge AS robot, email_challenge AS email, data_challenge AS
> > data, hit_challenge AS hit, start_date_challenge AS start_date FROM
> > challenge_table WHERE id_challenge = %s", $cookie)) {
> > + Sympa::Log::Syslog::do_log('err','Unable to retrieve challenge %s
> > from database',$cookie);
> > + return undef;
> > + }
> > +
> > + my $challenge = $sth->fetchrow_hashref('NAME_lc');
> > +
> > + unless ($challenge) {
> > + return 'not_found';
> > + }
> > + my $challenge_datas;
> > +
> > + my %datas= &tools::string_2_hash($challenge->{'data'});
> > + foreach my $key (keys %datas) {$challenge_datas->{$key} =
> > $datas{$key};}
> > +
> > + $challenge_datas->{'id_challenge'} = $challenge->{'id_challenge'};
> > + $challenge_datas->{'date'} = $challenge->{'date'};
> > + $challenge_datas->{'robot'} = $challenge->{'robot'};
> > + $challenge_datas->{'email'} = $challenge->{'email'};
> > +
> > + Sympa::Log::Syslog::do_log('debug3', 'Challenge::load(): removing
> > existing challenge del_statement = %s',$del_statement);
> > + unless(&SDM::do_query("DELETE FROM challenge_table WHERE
> > (id_challenge=%s)",$id_challenge)) {
> > + Sympa::Log::Syslog::do_log('err','Unable to delete challenge %s from
> > database',$id_challenge);
> > + return undef;
> > + }
> > +
> > + return ('expired') if (time - $challenge_datas->{'date'} >=
> > &tools::duration_conv(Site->challenge_table_ttl));
> > + return ($challenge_datas);
> > +}
> > +
> > +
> > +sub store {
> > +
> > + my $challenge = shift;
> > + Sympa::Log::Syslog::do_log('debug', 'Challenge::store()');
> > +
> > + return undef unless ($challenge->{'id_challenge'});
> > +
> > + my %hash ;
> > + foreach my $var (keys %$challenge ) {
> > + next if ($challenge_hard_attributes{$var});
> > + next unless ($var);
> > + $hash{$var} = $challenge->{$var};
> > + }
> > + my $data_string = &tools::hash_2_string (\%hash);
> > + my $sth;
> > +
> > + unless(&SDM::do_query("INSERT INTO challenge_table (id_challenge,
> > date_challenge, robot_challenge, email_challenge, data_challenge) VALUES
> > ('%s','%s','%s','%s','%s'')",$challenge->{'id_challenge'},$challenge->{'date'},$challenge->{'robot'},$challenge->{'email'},$data_string))
> > {
> > + Sympa::Log::Syslog::do_log('err','Unable to store challenge %s
> > informations in database (robot: %s, user:
> > %s)',$challenge->{'id_challenge'},$challenge->{'robot'},$challenge->{'email'});
> > + return undef;
> > + }
> > +}
> > +
> > +1;
> > +
> > Modified: trunk/src/lib/Makefile.am (10084 => 10085)
> > --- trunk/src/lib/Makefile.am 2014-01-02 09:09:01 UTC (rev 10084)
> > +++ trunk/src/lib/Makefile.am 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -10,7 +10,9 @@
> > DBManipulatorMySQL.pm DBManipulatorSQLite.pm\
> > DBManipulatorSybase.pm DBManipulatorOracle.pm \
> > DBManipulatorPostgres.pm DBManipulatorDefault.pm \
> > - listdef.pm moddef.pm Site.pm User.pm BounceMessage.pm
> > + listdef.pm moddef.pm Site.pm User.pm BounceMessage.pm \
> > + wwslib.pm cookielib.pm Marc.pm Auth.pm \
> > + Marc/Search.pm SharedDocument.pm SympaSession.pm
> >
> > EXTRA_DIST = Sympa/Constants.pm.in $(nobase_modules_DATA)
> > CLEANFILES = Sympa/Constants.pm
> > Copied: trunk/src/lib/Marc.pm (from rev 10083, trunk/wwsympa/Marc.pm) (0
> > => 10085)
> > --- trunk/src/lib/Marc.pm (rev 0)
> > +++ trunk/src/lib/Marc.pm 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -0,0 +1,58 @@
> > +package Marc;
> > +
> > +use strict;
> > +
> > +use Carp;
> > +
> > +our $AUTOLOAD;
> > +our $VERSION = "4.3";
> > +
> > +##------------------------------------------------------------------------##
> > +## Constructor
> > +
> > +sub new
> > +{
> > + my $class = shift;
> > + my $fields_ref = shift;
> > + my $self =
> > + {
> > + directory_labels => {},
> > + permitted => $fields_ref,
> > + sort_function => 'sub { $a cmp $b }',
> > + %$fields_ref,
> > + };
> > + $self->{permitted}->{sort_function} = 'sub { $a cmp $b }';
> > + bless $self,$class;
> > + return $self;
> > +}
> > +
> > +##------------------------------------------------------------------------##
> > +## The AUTOLOAD function allows for the dynamic creation of accessor
> > methods
> > +
> > +sub AUTOLOAD
> > +{
> > + my $self = shift;
> > + my $type = ref($self) or croak "$self is not an object";
> > + my $name = $AUTOLOAD;
> > +
> > + # DESTROY messages should never be propagated.
> > + return if $name =~ /::DESTROY$/;
> > + # Remove the package name.
> > + $name =~ s/^.*://;
> > +
> > + unless (exists($self->{permitted}->{$name}))
> > + {
> > + &message('arcsearch_marc_autoload_no_access');
> > + &wwslog('info','arcsearch_marc: Can not access %s field in
> > object of class %s', $name, $type);
> > + return undef;
> > + }
> > + if (@_)
> > + {
> > + return $self->{$name} = shift;
> > + }
> > + else
> > + {
> > + return $self->{$name};
> > + }
> > +}
> > +1;
> > Copied: trunk/src/lib/SharedDocument.pm (from rev 10083,
> > trunk/wwsympa/SharedDocument.pm) (0 => 10085)
> > --- trunk/src/lib/SharedDocument.pm (rev 0)
> > +++ trunk/src/lib/SharedDocument.pm 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -0,0 +1,533 @@
> > +# SharedDocument.pm - module to manipulate shared web documents
> > +# 
> > +
> > +#
> > +# Sympa - SYsteme de Multi-Postage Automatique
> > +# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des
> > Universites
> > +# Copyright (c) 1997,1998, 1999 Institut Pasteur & Christophe Wolfhugel
> > +#
> > +# This program is free software; you can redistribute it and/or modify
> > +# it under the terms of the GNU General Public License as published by
> > +# the Free Software Foundation; either version 2 of the License, or
> > +# (at your option) any later version.
> > +#
> > +# This program is distributed in the hope that it will be useful,
> > +# but WITHOUT ANY WARRANTY; without even the implied warranty of
> > +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> > +# GNU General Public License for more details.
> > +#
> > +# You should have received a copy of the GNU General Public License
> > +# along with this program. If not, see <http://www.gnu.org/licenses/>.
> > +
> > +package SharedDocument;
> > +
> > +use strict;
> > +
> > +#use Carp; # currently not used
> > +#use POSIX; # no longer used
> > +
> > +use tools;
> > +use Language qw(gettext_strftime);
> > +
> > +#use List; # not used
> > +use Log;
> > +
> > +## Creates a new object
> > +sub new {
> > + Sympa::Log::Syslog::do_log('debug2', '(%s, %s, %s, %s)', @_);
> > + my ($pkg, $list, $path, $param) = @_;
> > +
> > + my $email = $param->{'user'}{'email'};
> > +
> > + #$email ||= 'nobody';
> > + my $document = {};
> > +
> > + unless (ref($list) =~ /List/i) {
> > + Sympa::Log::Syslog::do_log('err', 'SharedDocument::new : incorrect
> > list parameter');
> > + return undef;
> > + }
> > +
> > + $document->{'root_path'} = $list->dir . '/shared';
> > +
> > + $document->{'path'} = &main::no_slash_end($path);
> > + $document->{'escaped_path'} =
> > + &tools::escape_chars($document->{'path'}, '/');
> > +
> > + ### Document isn't a description file
> > + if ($document->{'path'} =~ /\.desc/) {
> > + Sympa::Log::Syslog::do_log('err', "SharedDocument::new : %s :
> > description file",
> > + $document->{'path'});
> > + return undef;
> > + }
> > +
> > + ## absolute path
> > + # my $doc;
> > + $document->{'absolute_path'} = $document->{'root_path'};
> > + if ($document->{'path'}) {
> > + $document->{'absolute_path'} .= '/' . $document->{'path'};
> > + }
> > +
> > + ## Check access control
> > + &check_access_control($document, $param);
> > +
> > + ###############################
> > + ## The path has been checked ##
> > + ###############################
> > +
> > + ### Document exist ?
> > + unless (-r $document->{'absolute_path'}) {
> > + Sympa::Log::Syslog::do_log(
> > + 'err',
> > + "SharedDocument::new : unable to read %s : no such file or
> > directory",
> > + $document->{'absolute_path'}
> > + );
> > + return undef;
> > + }
> > +
> > + ### Document has non-size zero?
> > + unless (-s $document->{'absolute_path'}) {
> > + Sympa::Log::Syslog::do_log(
> > + 'err',
> > + "SharedDocument::new : unable to read %s : empty document",
> > + $document->{'absolute_path'}
> > + );
> > + return undef;
> > + }
> > +
> > + $document->{'visible_path'} =
> > + &main::make_visible_path($document->{'path'});
> > +
> > + ## Date
> > + my @info = stat $document->{'absolute_path'};
> > + $document->{'date'} = gettext_strftime "%d %b %Y", localtime
> > $info[9];
> > + $document->{'date_epoch'} = $info[9];
> > +
> > + # Size of the doc
> > + $document->{'size'} = (-s $document->{'absolute_path'}) / 1000;
> > +
> > + ## Filename
> > + my @tokens = split /\//, $document->{'path'};
> > + $document->{'filename'} = $document->{'visible_filename'} =
> > + $tokens[$#tokens];
> > +
> > + ## Moderated document
> > + if ($document->{'filename'} =~ /^\.(.*)(\.moderate)$/) {
> > + $document->{'moderate'} = 1;
> > + $document->{'visible_filename'} = $1;
> > + }
> > +
> > + $document->{'escaped_filename'} =
> > + &tools::escape_chars($document->{'filename'});
> > +
> > + ## Father dir
> > + if ($document->{'path'} =~ /^(([^\/]*\/)*)([^\/]+)$/) {
> > + $document->{'father_path'} = $1;
> > + } else {
> > + $document->{'father_path'} = '';
> > + }
> > + $document->{'escaped_father_path'} =
> > + &tools::escape_chars($document->{'father_path'}, '/');
> > +
> > + ### File, directory or URL ?
> > + if (!(-d $document->{'absolute_path'})) {
> > +
> > + if ($document->{'filename'} =~ /^\..*\.(\w+)\.moderate$/) {
> > + $document->{'file_extension'} = $1;
> > + } elsif ($document->{'filename'} =~ /^.*\.(\w+)$/) {
> > + $document->{'file_extension'} = $1;
> > + }
> > +
> > + if ($document->{'file_extension'} eq 'url') {
> > + $document->{'type'} = 'url';
> > + } else {
> > + $document->{'type'} = 'file';
> > + }
> > + } else {
> > + $document->{'type'} = 'directory';
> > + }
> > +
> > + ## Load .desc file unless root directory
> > + my $desc_file;
> > + if ($document->{'type'} eq 'directory') {
> > + $desc_file = $document->{'absolute_path'} . '/.desc';
> > + } else {
> > + if ($document->{'absolute_path'} =~ /^(([^\/]*\/)*)([^\/]+)$/) {
> > + $desc_file = $1 . '.desc.' . $3;
> > + } else {
> > + Sympa::Log::Syslog::do_log(
> > + 'err',
> > + "SharedDocument::new() : cannot determine desc file for %s",
> > + $document->{'absolute_path'}
> > + );
> > + return undef;
> > + }
> > + }
> > +
> > + if ($document->{'path'} && (-e $desc_file)) {
> > + my @info = stat $desc_file;
> > + $document->{'serial_desc'} = $info[9];
> > +
> > + my %desc_hash = &main::get_desc_file($desc_file);
> > + $document->{'owner'} = $desc_hash{'email'};
> > + $document->{'title'} = $desc_hash{'title'};
> > + $document->{'escaped_title'} =
> > + &tools::escape_html($document->{'title'});
> > +
> > + # Author
> > + if ($desc_hash{'email'}) {
> > + $document->{'author'} = $desc_hash{'email'};
> > + $document->{'author_mailto'} =
> > + &main::mailto($list, $desc_hash{'email'});
> > + $document->{'author_known'} = 1;
> > + }
> > + }
> > +
> > + ### File, directory or URL ?
> > + if ($document->{'type'} eq 'url') {
> > +
> > + $document->{'icon'} = &main::get_icon('url');
> > +
> > + open DOC, $document->{'absolute_path'};
> > + my $url = <DOC>;
> > + close DOC;
> > + chomp $url;
> > + $document->{'url'} = $url;
> > +
> > + if ($document->{'filename'} =~ /^(.+)\.url/) {
> > + $document->{'anchor'} = $1;
> > + }
> > + } elsif ($document->{'type'} eq 'file') {
> > +
> > + if (my $type = &main::get_mime_type($document->{'file_extension'})) {
> > +
> > + # type of the file and apache icon
> > + if ($type =~ /^([\w\-]+)\/([\w\-]+)$/) {
> > + my ($mimet, $subt) = ($1, $2);
> > + if ($subt) {
> > + if ($subt =~ /^octet-stream$/) {
> > + $mimet = 'octet-stream';
> > + $subt = 'binary';
> > + }
> > + $type = "$subt file";
> > + }
> > + $document->{'icon'} = &main::get_icon($mimet) ||
> > + &main::get_icon('unknown');
> > + }
> > + } else {
> > +
> > + # unknown file type
> > + $document->{'icon'} = &main::get_icon('unknown');
> > + }
> > +
> > + ## HTML file
> > + if ($document->{'file_extension'} =~ /^html?$/i) {
> > + $document->{'html'} = 1;
> > + $document->{'icon'} = &main::get_icon('text');
> > + }
> > +
> > + ## Directory
> > + } else {
> > +
> > + $document->{'icon'} = &main::get_icon('folder');
> > +
> > + # listing of all the shared documents of the directory
> > + unless (opendir DIR, $document->{'absolute_path'}) {
> > + Sympa::Log::Syslog::do_log(
> > + 'err',
> > + "SharedDocument::new() : cannot open %s : %s",
> > + $document->{'absolute_path'}, $!
> > + );
> > + return undef;
> > + }
> > +
> > + # array of entry of the directory DIR
> > + my @tmpdir = readdir DIR;
> > + closedir DIR;
> > +
> > + my $dir =
> > + &main::get_directory_content(\@tmpdir, $email, $list,
> > + $document->{'absolute_path'});
> > +
> > + foreach my $d (@{$dir}) {
> > +
> > + my $sub_document =
> > + new SharedDocument($list, $document->{'path'} . '/' . $d,
> > + $param);
> > + push @{$document->{'subdir'}}, $sub_document;
> > + }
> > + }
> > +
> > + $document->{'list'} = $list;
> > +
> > + ## Bless Message object
> > + bless $document, $pkg;
> > +
> > + return $document;
> > +}
> > +
> > +sub dump {
> > + my $self = shift;
> > + my $fd = shift;
> > +
> > + &tools::dump_var($self, 0, $fd);
> > +
> > +}
> > +
> > +sub dup {
> > + my $self = shift;
> > +
> > + my $copy = {};
> > +
> > + foreach my $k (keys %$self) {
> > + $copy->{$k} = $self->{$k};
> > + }
> > +
> > + return $copy;
> > +}
> > +
> > +## Regulars
> > +# read(/) = default (config list)
> > +# edit(/) = default (config list)
> > +# control(/) = not defined
> > +# read(A/B)= (read(A) && read(B)) ||
> > +# (author(A) || author(B))
> > +# edit = idem read
> > +# control (A/B) : author(A) || author(B)
> > +# + (set owner A/B) if (empty directory &&
> > +# control A)
> > +
> > +sub check_access_control {
> > +
> > + # Arguments:
> > + # (\%mode,$path)
> > + # if mode->{'read'} control access only for read
> > + # if mode->{'edit'} control access only for edit
> > + # if mode->{'control'} control access only for control
> > +
> > +# return the hash (
> > +# $result{'may'}{'read'} == $result{'may'}{'edit'} ==
> > $result{'may'}{'control'} if is_author else :
> > +# $result{'may'}{'read'} = 0 or 1 (right or not)
> > +# $result{'may'}{'edit'} = 0(not may edit) or 0.5(may edit with
> > moderation) or 1(may edit ) : it is not a boolean anymore
> > +# $result{'may'}{'control'} = 0 or 1 (right or not)
> > +# $result{'reason'}{'read'} = string for authorization_reject.tt2 when
> > may_read == 0
> > +# $result{'reason'}{'edit'} = string for authorization_reject.tt2 when
> > may_edit == 0
> > +# $result{'scenario'}{'read'} = scenario name for the document
> > +# $result{'scenario'}{'edit'} = scenario name for the document
> > +
> > + # Result
> > + my %result;
> > + $result{'reason'} = {};
> > +
> > + # Control
> > +
> > + # Arguments
> > + my $self = shift;
> > + my $param = shift;
> > +
> > + my $list = $self->{'list'};
> > +
> > + Sympa::Log::Syslog::do_log('debug', "check_access_control(%s)",
> > $self->{'path'});
> > +
> > + # Control for editing
> > + my $may_read = 1;
> > + my $why_not_read = '';
> > + my $may_edit = 1;
> > + my $why_not_edit = '';
> > +
> > + ## First check privileges on the root shared directory
> > + $result{'scenario'}{'read'} = $list->shared_doc->{'d_read'}{'name'};
> > + $result{'scenario'}{'edit'} = $list->shared_doc->{'d_edit'}{'name'};
> > +
> > + ## Privileged owner has all privileges
> > + if ($param->{'is_privileged_owner'}) {
> > + $result{'may'}{'read'} = 1;
> > + $result{'may'}{'edit'} = 1;
> > + $result{'may'}{'control'} = 1;
> > +
> > + $self->{'access'} = \%result;
> > + return 1;
> > + }
> > +
> > + # if not privileged owner
> > + if (1) {
> > + my $result = Scenario::request_action(
> > + $list,
> > + 'shared_doc.d_read',
> > + $param->{'auth_method'},
> > + { 'sender' => $param->{'user'}{'email'},
> > + 'remote_host' => $param->{'remote_host'},
> > + 'remote_addr' => $param->{'remote_addr'}
> > + }
> > + );
> > + my $action;
> > + if (ref($result) eq 'HASH') {
> > + $action = $result->{'action'};
> > + $why_not_read = $result->{'reason'};
> > + }
> > +
> > + $may_read = ($action =~ /do_it/i);
> > + }
> > +
> > + if (1) {
> > + my $result = Scenario::request_action(
> > + $list,
> > + 'shared_doc.d_edit',
> > + $param->{'auth_method'},
> > + { 'sender' => $param->{'user'}{'email'},
> > + 'remote_host' => $param->{'remote_host'},
> > + 'remote_addr' => $param->{'remote_addr'}
> > + }
> > + );
> > + my $action;
> > + if (ref($result) eq 'HASH') {
> > + $action = $result->{'action'};
> > + $why_not_edit = $result->{'reason'};
> > + }
> > +
> > + #edit = 0, 0.5 or 1
> > + $may_edit = &main::find_edit_mode($action);
> > + $why_not_edit = '' if ($may_edit);
> > + }
> > +
> > + ## Only authenticated users can edit files
> > + unless ($param->{'user'}{'email'}) {
> > + $may_edit = 0;
> > + $why_not_edit = 'not_authenticated';
> > + }
> > +
> > + my $current_path = $self->{'path'};
> > + my $current_document;
> > + my %desc_hash;
> > + my $user = $param->{'user'}{'email'} || 'nobody';
> > +
> > + while ($current_path ne "") {
> > +
> > + # no description file found yet
> > + my $def_desc_file = 0;
> > + my $desc_file;
> > +
> > + $current_path =~ /^(([^\/]*\/)*)([^\/]+)(\/?)$/;
> > + $current_document = $3;
> > + my $next_path = $1;
> > +
> > + # opening of the description file appropriated
> > + if (-d $self->{'root_path'} . '/' . $current_path) {
> > +
> > + # case directory
> > +
> > + # unless ($slash) {
> > + $current_path = $current_path . '/';
> > +
> > + # }
> > +
> > + if (-e "$self->{'root_path'}/$current_path.desc") {
> > + $desc_file =
> > + $self->{'root_path'} . '/' . $current_path . ".desc";
> > + $def_desc_file = 1;
> > + }
> > +
> > + } else {
> > +
> > + # case file
> > + if (-e "$self->{'root_path'}/$next_path.desc.$3") {
> > + $desc_file =
> > + $self->{'root_path'} . '/' . $next_path . ".desc." . $3;
> > + $def_desc_file = 1;
> > + }
> > + }
> > +
> > + if ($def_desc_file) {
> > +
> > + # a description file was found
> > + # loading of acces information
> > +
> > + %desc_hash = &main::get_desc_file($desc_file);
> > +
> > + ## Author has all privileges
> > + if ($user eq $desc_hash{'email'}) {
> > + $result{'may'}{'read'} = 1;
> > + $result{'may'}{'edit'} = 1;
> > + $result{'may'}{'control'} = 1;
> > +
> > + $self->{'access'} = \%result;
> > + return 1;
> > + }
> > +
> > + if (1) {
> > +
> > + my $result = Scenario::request_action(
> > + $list,
> > + 'shared_doc.d_read',
> > + $param->{'auth_method'},
> > + { 'sender' => $param->{'user'}{'email'},
> > + 'remote_host' => $param->{'remote_host'},
> > + 'remote_addr' => $param->{'remote_addr'},
> > + 'scenario' => $desc_hash{'read'}
> > + }
> > + );
> > + my $action;
> > + if (ref($result) eq 'HASH') {
> > + $action = $result->{'action'};
> > + $why_not_read = $result->{'reason'};
> > + }
> > +
> > + $may_read = $may_read && ($action =~ /do_it/i);
> > + $why_not_read = '' if ($may_read);
> > + }
> > +
> > + if (1) {
> > + my $result = Scenario::request_action(
> > + $list,
> > + 'shared_doc.d_edit',
> > + $param->{'auth_method'},
> > + { 'sender' => $param->{'user'}{'email'},
> > + 'remote_host' => $param->{'remote_host'},
> > + 'remote_addr' => $param->{'remote_addr'},
> > + 'scenario' => $desc_hash{'edit'}
> > + }
> > + );
> > + my $action_edit;
> > + if (ref($result) eq 'HASH') {
> > + $action_edit = $result->{'action'};
> > + $why_not_edit = $result->{'reason'};
> > + }
> > +
> > + # $may_edit = 0, 0.5 or 1
> > + my $may_action_edit = &main::find_edit_mode($action_edit);
> > + $may_edit = &main::merge_edit($may_edit, $may_action_edit);
> > + $why_not_edit = '' if ($may_edit);
> > +
> > + }
> > +
> > + ## Only authenticated users can edit files
> > + unless ($param->{'user'}{'email'}) {
> > + $may_edit = 0;
> > + $why_not_edit = 'not_authenticated';
> > + }
> > +
> > + unless (defined $result{'scenario'}{'read'}) {
> > + $result{'scenario'}{'read'} = $desc_hash{'read'};
> > + $result{'scenario'}{'edit'} = $desc_hash{'edit'};
> > + }
> > +
> > + }
> > +
> > + # truncate the path for the while
> > + $current_path = $next_path;
> > + }
> > +
> > + if (1) {
> > + $result{'may'}{'read'} = $may_read;
> > + $result{'reason'}{'read'} = $why_not_read;
> > + }
> > +
> > + if (1) {
> > + $result{'may'}{'edit'} = $may_edit;
> > + $result{'reason'}{'edit'} = $why_not_edit;
> > + }
> > +
> > + $self->{'access'} = \%result;
> > + return 1;
> > +}
> > +
> > +1;
> > Copied: trunk/src/lib/SympaSession.pm (from rev 10083,
> > trunk/wwsympa/SympaSession.pm) (0 => 10085)
> > --- trunk/src/lib/SympaSession.pm (rev 0)
> > +++ trunk/src/lib/SympaSession.pm 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -0,0 +1,796 @@
> > +# SympaSession.pm - This module includes functions managing HTTP
> > sessions in Sympa
> > +#
> > +# Sympa - SYsteme de Multi-Postage Automatique
> > +# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des
> > Universites
> > +# Copyright (c) 1997,1998, 1999 Institut Pasteur & Christophe Wolfhugel
> > +#
> > +# This program is free software; you can redistribute it and/or modify
> > +# it under the terms of the GNU General Public License as published by
> > +# the Free Software Foundation; either version 2 of the License, or
> > +# (at your option) any later version.
> > +#
> > +# This program is distributed in the hope that it will be useful,
> > +# but WITHOUT ANY WARRANTY; without even the implied warranty of
> > +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> > +# GNU General Public License for more details.
> > +#
> > +# You should have received a copy of the GNU General Public License
> > +# along with this program. If not, see <http://www.gnu.org/licenses/>.
> > +
> > +package SympaSession;
> > +
> > +use strict;
> > +
> > +use CGI::Cookie;
> > +#use Digest::MD5; # no longer used
> > +#use POSIX; # no longer used
> > +#use Time::Local; # not used
> > +
> > +#use Conf; # no longer used
> > +#use Log; # used by SDM
> > +use SDM;
> > +
> > +# this structure is used to define which session attributes are stored
> > in a
> > +# dedicated database col where others are compiled in col 'data_session'
> > +my %session_hard_attributes = ('id_session' => 1,
> > + 'prev_id' => 1,
> > + 'date' => 1,
> > + 'refresh_date' => 1,
> > + 'remote_addr' => 1,
> > + 'robot' => 1,
> > + 'email' => 1,
> > + 'start_date' => 1,
> > + 'hit' => 1,
> > + 'new_session' => 1,
> > + );
> > +
> > +sub new {
> > + my $pkg = shift;
> > + my $robot = Robot::clean_robot(shift, 1); #FIXME: maybe a Site
> > object?
> > + my $context = shift || {};
> > +
> > + my $cookie = $context->{'cookie'};
> > + my $action = $context->{'action'};
> > + my $rss = $context->{'rss'};
> > + my $ajax = $context->{'ajax'};
> > + Sympa::Log::Syslog::do_log('debug2', '(%s, cookie=%s, action=%s)',
> > + $robot, $cookie, $action);
> > +
> > + my $self = {'robot' => $robot};
> > + bless $self => $pkg;
> > +
> > + # passive_session are session not stored in the database, they are
> > used
> > + # for crawler bots and action such as css, wsdl, ajax and rss
> > +
> > + if (tools::is_a_crawler($robot,
> > + {'user_agent_string' => $ENV{'HTTP_USER_AGENT'}})) {
> > + $self->{'is_a_crawler'} = 1;
> > + $self->{'passive_session'} = 1;
> > + }
> > + $self->{'passive_session'} = 1
> > + if $rss or $action eq 'wsdl' or $action eq 'css';
> > +
> > + # if a session cookie exists, try to restore an existing session,
> > don't
> > + # store sessions from bots
> > + if ($cookie and $self->{'passive_session'} != 1){
> > + my $status ;
> > + $status = $self->load($cookie);
> > + unless (defined $status) {
> > + return undef;
> > + }
> > + if ($status eq 'not_found') {
> > + # start a new session (may be a fake cookie)
> > + Sympa::Log::Syslog::do_log('info', 'ignoring unknown session
> > cookie "%s"',
> > + $cookie);
> > + return __PACKAGE__->new($robot);
> > + }
> > + } else {
> > + # create a new session context
> > + ## Tag this session as new, ie no data in the DB exist
> > + $self->{'new_session'} = 1;
> > + $self->{'id_session'} = get_random();
> > + $self->{'email'} = 'nobody';
> > + $self->{'remote_addr'} = $ENV{'REMOTE_ADDR'};
> > + $self->{'date'} = $self->{'start_date'} = $self->{'refresh_date'} =
> > + time;
> > + $self->{'hit'} = 1;
> > + ##$self->{'robot'} = $robot->name;
> > + $self->{'data'} = '';
> > + }
> > + return $self;
> > +}
> > +
> > +sub load {
> > + Sympa::Log::Syslog::do_log('debug2', '(%s, %s)', @_);
> > + my $self = shift;
> > + my $cookie = shift;
> > +
> > + unless ($cookie) {
> > + Sympa::Log::Syslog::do_log('err', 'internal error, undef id_session');
> > + return undef;
> > + }
> > +
> > + my $sth;
> > + my $id_session;
> > + my $is_old_session = 0;
> > +
> > + ## Load existing session.
> > + if ($cookie and $cookie =~ /^\d{,16}$/) {
> > + ## Compatibility: session by older releases of Sympa.
> > + $id_session = $cookie;
> > + $is_old_session = 1;
> > +
> > + ## Session by older releases of Sympa doesn't have refresh_date.
> > + unless ($sth = SDM::do_prepared_query(
> > + q{SELECT id_session AS id_session, id_session AS prev_id,
> > + date_session AS "date",
> > + remote_addr_session AS remote_addr,
> > + robot_session AS robot, email_session AS email,
> > + data_session AS data, hit_session AS hit,
> > + start_date_session AS start_date,
> > + date_session AS refresh_date
> > + FROM session_table
> > + WHERE robot_session = ? AND
> > + id_session = ? AND
> > + refresh_date_session IS NULL},
> > + $self->{'robot'}->name, $id_session
> > + )) {
> > + Sympa::Log::Syslog::do_log('err', 'Unable to load session %s',
> > $id_session);
> > + return undef;
> > + }
> > + } else {
> > + $id_session = decrypt_session_id($cookie);
> > + unless ($id_session) {
> > + Sympa::Log::Syslog::do_log('err', 'internal error, undef
> > id_session');
> > + return 'not_found';
> > + }
> > +
> > + ## Cookie may contain current or previous session ID.
> > + unless ($sth = SDM::do_prepared_query(
> > + q{SELECT id_session AS id_session, prev_id_session AS prev_id,
> > + date_session AS "date",
> > + remote_addr_session AS remote_addr,
> > + robot_session AS robot, email_session AS email,
> > + data_session AS data, hit_session AS hit,
> > + start_date_session AS start_date,
> > + refresh_date_session AS refresh_date
> > + FROM session_table
> > + WHERE robot_session = ? AND
> > + (id_session = ? AND prev_id_session IS NOT NULL OR
> > + prev_id_session = ?)},
> > + $self->{'robot'}->name, $id_session, $id_session
> > + )) {
> > + Sympa::Log::Syslog::do_log('err', 'Unable to load session %s',
> > $id_session);
> > + return undef;
> > + }
> > + }
> > +
> > + my $session = undef;
> > + my $new_session = undef;
> > + my $counter = 0;
> > + while ($new_session = $sth->fetchrow_hashref('NAME_lc')) {
> > + if ($counter > 0) {
> > + Sympa::Log::Syslog::do_log('err',
> > + 'The SQL statement did return more than one session');
> > + $session->{'email'} = '';
> > + last;
> > + }
> > + $session = $new_session;
> > + $counter++;
> > + }
> > +
> > + unless ($session) {
> > + return 'not_found';
> > + }
> > +
> > + ## Compatibility: Upgrade session by older releases of Sympa.
> > + if ($is_old_session) {
> > + SDM::do_prepared_query(
> > + q{UPDATE session_table
> > + SET prev_id_session = id_session
> > + WHERE id_session = ? AND prev_id_session IS NULL AND
> > + refresh_date_session IS NULL},
> > + $id_session
> > + );
> > + }
> > +
> > + my %datas = tools::string_2_hash($session->{'data'});
> > +
> > + ## canonicalize lang if possible.
> > + $datas{'lang'} =
> > + Language::CanonicLang($datas{'lang'}) || $datas{'lang'}
> > + if $datas{'lang'};
> > +
> > + foreach my $key (keys %datas) {$self->{$key} = $datas{$key};}
> > +
> > + $self->{'id_session'} = $session->{'id_session'};
> > + $self->{'prev_id'} = $session->{'prev_id'};
> > + $self->{'date'} = $session->{'date'};
> > + $self->{'start_date'} = $session->{'start_date'};
> > + $self->{'refresh_date'} = $session->{'refresh_date'};
> > + $self->{'hit'} = $session->{'hit'} +1 ;
> > + $self->{'remote_addr'} = $session->{'remote_addr'};
> > + ##$self->{'robot'} = $session->{'robot'};
> > + $self->{'email'} = $session->{'email'};
> > +
> > + return ($self);
> > +}
> > +
> > +## This method will both store the session information in the database
> > +sub store {
> > + Sympa::Log::Syslog::do_log('debug2', '(%s)', @_);
> > + my $self = shift;
> > +
> > + return undef unless $self->{'id_session'};
> > + # do not create a session in session table for crawlers;
> > + return if $self->{'is_a_crawler'};
> > + # do not create a session in session table for action such as RSS or
> > CSS
> > + # or wsdl that do not require this sophistication;
> > + return if $self->{'passive_session'};
> > +
> > + my %hash;
> > + foreach my $var (keys %$self ) {
> > + next if ($session_hard_attributes{$var});
> > + next unless ($var);
> > + $hash{$var} = $self->{$var};
> > + }
> > + my $data_string = tools::hash_2_string (\%hash);
> > + my $time = time;
> > +
> > + ## If this is a new session, then perform an INSERT
> > + if ($self->{'new_session'}) {
> > + ## Store the new session ID in the DB
> > + ## Previous session ID is set to be same as new session ID.
> > + unless (SDM::do_prepared_query(
> > + q{INSERT INTO session_table
> > + (id_session, prev_id_session,
> > + date_session, refresh_date_session,
> > + remote_addr_session, robot_session,
> > + email_session, start_date_session, hit_session,
> > + data_session)
> > + VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)},
> > + $self->{'id_session'}, $self->{'id_session'},
> > + $time, $time,
> > + $ENV{'REMOTE_ADDR'}, $self->{'robot'}->name,
> > + $self->{'email'}, $self->{'start_date'}, $self->{'hit'},
> > + $data_string
> > + )) {
> > + Sympa::Log::Syslog::do_log('err',
> > + 'Unable to add new session %s informations in database',
> > + $self->{'id_session'}
> > + );
> > + return undef;
> > + }
> > +
> > + $self->{'prev_id'} = $self->{'id_session'};
> > +
> > + } else {
> > + ## If the session already exists in DB, then perform an UPDATE
> > +
> > + ## Cookie may contain previous session ID.
> > + my $sth = SDM::do_prepared_query(
> > + q{SELECT id_session
> > + FROM session_table
> > + WHERE robot_session = ? AND prev_id_session = ?},
> > + $self->{'robot'}->name, $self->{'id_session'}
> > + );
> > + unless ($sth) {
> > + Sympa::Log::Syslog::do_log('err',
> > + 'Unable to update session information in database');
> > + return undef;
> > + }
> > + if ($sth->rows) {
> > + my $new_id = $sth->fetchrow;
> > + $sth->finish;
> > + if ($new_id) {
> > + $self->{'prev_id'} = $self->{'id_session'};
> > + $self->{'id_session'} = $new_id;
> > + }
> > + }
> > +
> > + ## Update the new session in the DB
> > + unless (SDM::do_prepared_query(
> > + q{UPDATE session_table
> > + SET date_session = ?, remote_addr_session = ?,
> > + robot_session = ?, email_session = ?,
> > + start_date_session = ?, hit_session = ?, data_session = ?
> > + WHERE robot_session = ? AND
> > + (id_session = ? AND prev_id_session IS NOT NULL OR
> > + prev_id_session = ?)},
> > + $time, $ENV{'REMOTE_ADDR'},
> > + $self->{'robot'}->name, $self->{'email'},
> > + $self->{'start_date'}, $self->{'hit'}, $data_string,
> > + $self->{'robot'}->name,
> > + $self->{'id_session'},
> > + $self->{'id_session'}
> > + )) {
> > + Sympa::Log::Syslog::do_log('err',
> > + 'Unable to update session %s information in database',
> > + $self->{'id_session'}
> > + );
> > + return undef;
> > + }
> > + }
> > +
> > + return 1;
> > +}
> > +
> > +## This method will renew the session ID
> > +sub renew {
> > + Sympa::Log::Syslog::do_log('debug2', '(%s)', @_);
> > + my $self = shift;
> > +
> > + return undef unless $self->{'id_session'};
> > + # do not create a session in session table for crawlers;
> > + return if $self->{'is_a_crawler'};
> > + # do not create a session in session table for action such as RSS or
> > CSS
> > + # or wsdl that do not require this sophistication;
> > + return if $self->{'passive_session'};
> > +
> > + my %hash;
> > + foreach my $var (keys %$self ) {
> > + next if ($session_hard_attributes{$var});
> > + next unless ($var);
> > + $hash{$var} = $self->{$var};
> > + }
> > + my $data_string = tools::hash_2_string(\%hash);
> > +
> > + my $sth;
> > + ## Cookie may contain previous session ID.
> > + $sth = SDM::do_prepared_query(
> > + q{SELECT id_session
> > + FROM session_table
> > + WHERE robot_session = ? AND prev_id_session = ?},
> > + $self->{'robot'}->name, $self->{'id_session'}
> > + );
> > + unless ($sth) {
> > + Sympa::Log::Syslog::do_log('err',
> > + 'Unable to update session information in database');
> > + return undef;
> > + }
> > + if ($sth->rows) {
> > + my $new_id = $sth->fetchrow;
> > + $sth->finish;
> > + if ($new_id) {
> > + $self->{'prev_id'} = $self->{'id_session'};
> > + $self->{'id_session'} = $new_id;
> > + }
> > + }
> > +
> > + ## Renew the session ID in order to prevent session hijacking
> > + my $new_id = get_random();
> > +
> > + ## Do refresh the session ID when remote address was changed or
> > refresh
> > + ## interval was past. Conditions also are checked by SQL so that
> > + ## simultaneous processes will be prevented renewing cookie.
> > + my $time = time;
> > + my $remote_addr = $ENV{'REMOTE_ADDR'};
> > + my $refresh_term;
> > + if (Site->cookie_refresh == 0) {
> > + $refresh_term = $time;
> > + } else {
> > + my $cookie_refresh = Site->cookie_refresh;
> > + $refresh_term =
> > + int($time - $cookie_refresh * 0.25 - rand($cookie_refresh * 0.5));
> > + }
> > + unless ($self->{'remote_addr'} ne $remote_addr or
> > + $self->{'refresh_date'} <= $refresh_term) {
> > + return 0;
> > + }
> > +
> > + ## First insert DB entry with new session ID,
> > + $sth = SDM::do_query(
> > + q{INSERT INTO session_table
> > + (id_session, prev_id_session,
> > + start_date_session, date_session, refresh_date_session,
> > + remote_addr_session, robot_session, email_session,
> > + hit_session, data_session)
> > + SELECT %s, id_session,
> > + start_date_session, date_session, %d,
> > + %s, robot_session, email_session,
> > + hit_session, data_session
> > + FROM session_table
> > + WHERE robot_session = %s AND
> > + (id_session = %s AND prev_id_session IS NOT NULL OR
> > + prev_id_session = %s) AND
> > + (remote_addr_session <> %s OR refresh_date_session <= %d)},
> > + SDM::quote($new_id),
> > + $time,
> > + SDM::quote($remote_addr),
> > + SDM::quote($self->{'robot'}->name),
> > + SDM::quote($self->{'id_session'}),
> > + SDM::quote($self->{'id_session'}),
> > + SDM::quote($remote_addr), $refresh_term
> > + );
> > + unless ($sth) {
> > + Sympa::Log::Syslog::do_log('err', 'Unable to renew session ID for
> > session %s',
> > + $self->{'id_session'});
> > + return undef;
> > + }
> > + unless ($sth->rows) {
> > + return 0;
> > + }
> > + ## Keep previous ID to prevent crosstalk, clearing grand-parent ID.
> > + SDM::do_prepared_query(
> > + q{UPDATE session_table
> > + SET prev_id_session = NULL
> > + WHERE robot_session = ? AND id_session = ?},
> > + $self->{'robot'}->name, $self->{'id_session'}
> > + );
> > + ## Remove record of grand-parent ID.
> > + SDM::do_prepared_query(
> > + q{DELETE FROM session_table
> > + WHERE id_session = ? AND prev_id_session IS NULL},
> > + $self->{'prev_id'}
> > + );
> > +
> > + ## Renew the session ID in order to prevent session hijacking
> > + Sympa::Log::Syslog::do_log('info',
> > + '[robot %s] [session %s] [client %s]%s new session %s',
> > + $self->{'robot'}->name, $self->{'id_session'}, $remote_addr,
> > + ($self->{'email'} ? sprintf(' [user %s]', $self->{'email'}) : ''),
> > + $new_id
> > + );
> > + $self->{'prev_id'} = $self->{'id_session'};
> > + $self->{'id_session'} = $new_id;
> > + $self->{'refresh_date'} = $time;
> > + $self->{'remote_addr'} = $remote_addr;
> > +
> > + return 1;
> > +}
> > +
> > +## remove old sessions from a particular robot or from all robots.
> > +## delay is a parameter in seconds
> > +sub purge_old_sessions {
> > + Sympa::Log::Syslog::do_log('debug2', '(%s)', @_);
> > + my $robot = Robot::clean_robot(shift, 1);
> > +
> > + my $delay = tools::duration_conv(Site->session_table_ttl);
> > + my $anonymous_delay =
> > + tools::duration_conv(Site->anonymous_session_table_ttl);
> > +
> > + unless ($delay) {
> > + Sympa::Log::Syslog::do_log('debug3', 'exit with delay null');
> > + return;
> > + }
> > + unless ($anonymous_delay) {
> > + Sympa::Log::Syslog::do_log('debug3', 'exit with anonymous delay
> > null');
> > + return;
> > + }
> > +
> > + my @sessions ;
> > + my $sth;
> > +
> > + my $condition = '';
> > + $condition = sprintf 'robot_session = %s', SDM::quote($robot->name)
> > + if ref $robot eq 'Robot';
> > + my $anonymous_condition = $condition;
> > +
> > + $condition .= sprintf '%s%d > date_session',
> > + ($condition ? ' AND ' : ''), time - $delay
> > + if $delay;
> > + $condition = " WHERE $condition"
> > + if $condition;
> > +
> > + $anonymous_condition .= sprintf '%s%d > date_session',
> > + ($anonymous_condition ? ' AND ' : ''), time - $anonymous_delay
> > + if $anonymous_delay;
> > + $anonymous_condition .= sprintf
> > + "%semail_session = 'nobody' AND hit_session = 1",
> > + ($anonymous_condition ? ' AND ' : '');
> > + $anonymous_condition = " WHERE $anonymous_condition"
> > + if $anonymous_condition;
> > +
> > + my $count_statement = q{SELECT count(*) FROM session_table%s};
> > + my $anonymous_count_statement = q{SELECT count(*) FROM
> > session_table%s};
> > + my $statement = q{DELETE FROM session_table%s};
> > + my $anonymous_statement = q{DELETE FROM session_table%s};
> > +
> > + unless ($sth = SDM::do_query($count_statement, $condition)) {
> > + Sympa::Log::Syslog::do_log('err', 'Unable to count old session for
> > robot %s', $robot);
> > + return undef;
> > + }
> > +
> > + my $total = $sth->fetchrow;
> > + if ($total == 0) {
> > + Sympa::Log::Syslog::do_log('debug3', 'no sessions to expire');
> > + }else{
> > + unless ($sth = SDM::do_query($statement, $condition)) {
> > + Sympa::Log::Syslog::do_log('err', 'Unable to purge old sessions
> > for robot %s',
> > + $robot);
> > + return undef;
> > + }
> > + }
> > + unless ($sth = SDM::do_query($anonymous_count_statement,
> > + $anonymous_condition)) {
> > + Sympa::Log::Syslog::do_log('err', 'Unable to count anonymous sessions
> > for robot %s',
> > + $robot);
> > + return undef;
> > + }
> > + my $anonymous_total = $sth->fetchrow;
> > + if ($anonymous_total == 0) {
> > + Sympa::Log::Syslog::do_log('debug3', 'no anonymous sessions to
> > expire');
> > + return $total ;
> > + }
> > + unless ($sth = SDM::do_query($anonymous_statement,
> > + $anonymous_condition)) {
> > + Sympa::Log::Syslog::do_log('err', 'Unable to purge anonymous sessions
> > for robot %s',
> > + $robot);
> > + return undef;
> > + }
> > + return $total+$anonymous_total;
> > +}
> > +
> > +
> > +## remove old one_time_ticket from a particular robot or from all
> > robots. delay is a parameter in seconds
> > +##
> > +sub purge_old_tickets {
> > + Sympa::Log::Syslog::do_log('debug2', '(%s)', @_);
> > + my $robot = Robot::clean_robot(shift, 1);
> > +
> > + my $delay = tools::duration_conv(Site->one_time_ticket_table_ttl);
> > + unless ($delay) {
> > + Sympa::Log::Syslog::do_log('debug3', 'exit with delay null');
> > + return;
> > + }
> > +
> > + my @tickets ;
> > + my $sth;
> > +
> > + my $condition = '';
> > + $condition = sprintf '%d > date_one_time_ticket', time - $delay
> > + if $delay;
> > + $condition .= sprintf '%srobot_one_time_ticket = %s',
> > + ($condition ? ' AND ' : ''), SDM::quote($robot->name)
> > + if ref $robot eq 'Robot';
> > + $condition = " WHERE $condition"
> > + if $condition;
> > +
> > + unless ($sth = SDM::do_query(
> > + q{SELECT count(*) FROM one_time_ticket_table%s},
> > + $condition
> > + )) {
> > + Sympa::Log::Syslog::do_log('err',
> > + 'Unable to count old one time tickets for robot %s', $robot);
> > + return undef;
> > + }
> > +
> > + my $total = $sth->fetchrow;
> > + if ($total == 0) {
> > + Sympa::Log::Syslog::do_log('debug3', 'no tickets to expire');
> > + }else{
> > + unless ($sth = SDM::do_query(
> > + q{DELETE FROM one_time_ticket_table%s},
> > + $condition
> > + )) {
> > + Sympa::Log::Syslog::do_log('err',
> > + 'Unable to delete expired one time tickets for robot %s',
> > + $robot);
> > + return undef;
> > + }
> > + }
> > + return $total;
> > +}
> > +
> > +# list sessions for $robot where last access is newer then $delay. List
> > is limited to connected users if $connected_only
> > +sub list_sessions {
> > + Sympa::Log::Syslog::do_log('debug2', '(%s, %s, %s)', @_);
> > + my $delay = shift;
> > + my $robot = Robot::clean_robot(shift, 1);
> > + my $connected_only = shift;
> > +
> > + my @sessions ;
> > + my $sth;
> > + my $time = time;
> > +
> > + my $condition = '';
> > + $condition = sprintf 'robot_session = %s', SDM::quote($robot->name)
> > + if ref $robot eq 'Robot';
> > + $condition .= sprintf '%s%d < date_session',
> > + ($condition ? ' AND ' : ''), $time - $delay
> > + if $delay;
> > + $condition .= sprintf "%semail_session <> 'nobody'",
> > + ($condition ? ' AND ' : '')
> > + if $connected_only eq 'on';
> > + $condition .= sprintf "%sprev_id_session IS NOT NULL",
> > + ($condition ? ' AND ' : '');
> > + $condition = " WHERE $condition"
> > + if $condition;
> > +
> > + unless ($sth = SDM::do_query(
> > + q{SELECT remote_addr_session, email_session, robot_session,
> > + date_session, start_date_session, hit_session
> > + FROM session_table%s},
> > + $condition
> > + )) {
> > + Sympa::Log::Syslog::do_log('err','Unable to get the list of sessions
> > for robot %s',
> > + $robot);
> > + return undef;
> > + }
> > +
> > + while (my $session = ($sth->fetchrow_hashref('NAME_lc'))) {
> > + $session->{'formated_date'} =
> > + Language::gettext_strftime("%d %b %y %H:%M",
> > localtime($session->{'date_session'}));
> > + $session->{'formated_start_date'} =
> > + Language::gettext_strftime ("%d %b %y %H:%M",
> > localtime($session->{'start_date_session'}));
> > +
> > + push @sessions, $session;
> > + }
> > +
> > + return \@sessions;
> > +}
> > +
> > +###############################
> > +# Subroutines to read cookies #
> > +###############################
> > +
> > +## Generic subroutine to get a cookie value
> > +sub get_session_cookie {
> > + my $http_cookie = shift;
> > +
> > + if ($http_cookie =~/\S+/g) {
> > + my %cookies = parse CGI::Cookie($http_cookie);
> > + foreach (keys %cookies) {
> > + my $cookie = $cookies{$_};
> > + next unless ($cookie->name eq 'sympa_session');
> > + return ($cookie->value);
> > + }
> > + }
> > +
> > + return (undef);
> > +}
> > +
> > +
> > +## Generic subroutine to set a cookie
> > +## Set user $email cookie, ckecksum use $secret,
> > expire=(now|session|#sec) domain=(localhost|<a domain>)
> > +sub set_cookie {
> > + Sympa::Log::Syslog::do_log('debug2', '(%s, %s, %s, %s)', @_);
> > + my ($self, $http_domain, $expires,$use_ssl) = @_ ;
> > +
> > + my $expiration;
> > + if ($expires =~ /now/i) {
> > + ## 10 years ago
> > + $expiration = '-10y';
> > + }else{
> > + $expiration = '+'.$expires.'m';
> > + }
> > +
> > + if ($http_domain eq 'localhost') {
> > + $http_domain="";
> > + }
> > +
> > + my $value = encrypt_session_id($self->{'id_session'});
> > +
> > + my $cookie;
> > + if ($expires =~ /session/i) {
> > + $cookie = new CGI::Cookie (-name => 'sympa_session',
> > + -value => $value,
> > + -domain => $http_domain,
> > + -path => '/',
> > + -secure => $use_ssl,
> > + -httponly => 1
> > + );
> > + }else {
> > + $cookie = new CGI::Cookie (-name => 'sympa_session',
> > + -value => $value,
> > + -expires => $expiration,
> > + -domain => $http_domain,
> > + -path => '/',
> > + -secure => $use_ssl,
> > + -httponly => 1
> > + );
> > + }
> > +
> > + ## Send cookie to the client
> > + printf "Set-Cookie: %s\n", $cookie->as_string;
> > + return 1;
> > +}
> > +
> > +# Build an HTTP cookie value to be sent to a SOAP client
> > +sub soap_cookie2 {
> > + my ($session_id, $http_domain, $expire) = @_;
> > + my $cookie;
> > + my $value;
> > +
> > + # WARNING : to check the cookie the SOAP services does not gives
> > + # all the cookie, only it's value so we need ':'
> > + $value = encrypt_session_id($session_id);
> > +
> > + ## With set-cookie2 max-age of 0 means removing the cookie
> > + ## Maximum cookie lifetime is the session
> > + $expire ||= 600; ## 10 minutes
> > +
> > + if ($http_domain eq 'localhost') {
> > + $cookie = CGI::Cookie->new(
> > + -name => 'sympa_session',
> > + -value => $value,
> > + -path => '/',
> > + );
> > + $cookie->max_age(time + $expire); # needs CGI >= 3.51.
> > + } else {
> > + $cookie = CGI::Cookie->new(
> > + -name => 'sympa_session',
> > + -value => $value,
> > + -domain => $http_domain,
> > + -path => '/',
> > + );
> > + $cookie->max_age(time + $expire); # needs CGI >= 3.51.
> > + }
> > +
> > + ## Return the cookie value
> > + return $cookie->as_string;
> > +}
> > +
> > +sub get_random {
> > + Sympa::Log::Syslog::do_log('debug3', '()');
> > + ## Concatenates 2 integers for a better entropy
> > + my $random = int(rand(10**7)).int(rand(10**7));
> > + $random =~ s/^0(\.|\,)//;
> > + return ($random)
> > +}
> > +
> > +## Return the session object content, as a hashref
> > +sub as_hashref {
> > + my $self = shift;
> > + my $data;
> > +
> > + foreach my $key (keys %{$self}) {
> > + if ($key eq 'robot') {
> > + $data->{$key} = $self->{'robot'}->name;
> > + } else {
> > + $data->{$key} = $self->{$key};
> > + }
> > + }
> > +
> > + return $data;
> > +}
> > +
> > +## Return 1 if the Session object corresponds to an anonymous session.
> > +sub is_anonymous {
> > + my $self = shift;
> > + if($self->{'email'} eq 'nobody' || $self->{'email'} eq '') {
> > + return 1;
> > + }else{
> > + return 0;
> > + }
> > +}
> > +
> > +## Generate cookie from session ID.
> > +sub encrypt_session_id {
> > + my $id_session = shift;
> > +
> > + return $id_session unless Site->cookie;
> > + my $cipher = tools::ciphersaber_installed();
> > + return $id_session unless $cipher;
> > +
> > + my $id_session_bin =
> > + pack 'nN', ($id_session >> 32), $id_session % (1 << 32);
> > + my $cookie_bin = $cipher->encrypt($id_session_bin);
> > + return sprintf '%*v02x', '', $cookie_bin;
> > +}
> > +
> > +## Get session ID from cookie.
> > +sub decrypt_session_id {
> > + my $cookie = shift;
> > +
> > + return $cookie unless Site->cookie;
> > + my $cipher = tools::ciphersaber_installed();
> > + return $cookie unless $cipher;
> > +
> > + return undef unless $cookie =~ /\A[0-9a-f]+\z/;
> > + my $cookie_bin = $cookie;
> > + $cookie_bin =~ s/([0-9a-f]{2})/sprintf '%c', hex("0x$1")/eg;
> > + my ($id_session_hi, $id_session_lo) =
> > + unpack 'nN', $cipher->decrypt($cookie_bin);
> > +
> > + return ($id_session_hi << 32) + $id_session_lo;
> > +}
> > +
> > +## Get unique ID
> > +sub get_id {
> > + my $self = shift;
> > + return '' unless $self->{'id_session'} and $self->{'robot'};
> > + return sprintf '%s@%s', $self->{'id_session'},
> > $self->{'robot'}->name;
> > +}
> > +
> > +1;
> > Copied: trunk/src/lib/cookielib.pm (from rev 10083,
> > trunk/wwsympa/cookielib.pm) (0 => 10085)
> > --- trunk/src/lib/cookielib.pm (rev 0)
> > +++ trunk/src/lib/cookielib.pm 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -0,0 +1,206 @@
> > +# cookielib.pm - This module includes functions managing HTTP cookies in
> > Sympa
> > +# RCS Identication ; $Revision$ ; $Date$
> > +#
> > +# Sympa - SYsteme de Multi-Postage Automatique
> > +# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des
> > Universites
> > +# Copyright (c) 1997,1998, 1999 Institut Pasteur & Christophe Wolfhugel
> > +#
> > +# This program is free software; you can redistribute it and/or modify
> > +# it under the terms of the GNU General Public License as published by
> > +# the Free Software Foundation; either version 2 of the License, or
> > +# (at your option) any later version.
> > +#
> > +# This program is distributed in the hope that it will be useful,
> > +# but WITHOUT ANY WARRANTY; without even the implied warranty of
> > +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> > +# GNU General Public License for more details.
> > +#
> > +# You should have received a copy of the GNU General Public License
> > +# along with this program. If not, see <http://www.gnu.org/licenses/>.
> > +
> > +package cookielib;
> > +
> > +use strict "vars";
> > +
> > +use Digest::MD5;
> > +use POSIX;
> > +use CGI::Cookie;
> > +
> > +use Log;
> > +
> > +## Generic subroutine to set a cookie
> > +sub generic_set_cookie {
> > + my %param = @_;
> > +
> > + my %cookie_param;
> > + foreach my $p ('name','value','expires','domain','path') {
> > + $cookie_param{'-'.$p} = $param{$p}; ## CGI::Cookie expects -param =>
> > value
> > + }
> > +
> > + if ($cookie_param{'-domain'} eq 'localhost') {
> > + $cookie_param{'-domain'} = '';
> > + }
> > +
> > + my $cookie = new CGI::Cookie(%cookie_param);
> > +
> > + ## Send cookie to the client
> > + printf "Set-Cookie: %s\n", $cookie->as_string;
> > +
> > + return 1;
> > +}
> > +
> > +
> > +
> > +# Sets an HTTP cookie to be sent to a SOAP client
> > +# OBSOLETED: Use SympaSession::soap_cookie2().
> > +sub set_cookie_soap {
> > + my ($session_id,$http_domain,$expire) = @_ ;
> > + my $cookie;
> > + my $value;
> > +
> > + # WARNING : to check the cookie the SOAP services does not gives
> > + # all the cookie, only it's value so we need ':'
> > + $value = $session_id;
> > +
> > + ## With set-cookie2 max-age of 0 means removing the cookie
> > + ## Maximum cookie lifetime is the session
> > + $expire ||= 600; ## 10 minutes
> > +
> > + if ($http_domain eq 'localhost') {
> > + $cookie = sprintf "%s=%s; Path=/; Max-Age=%s", 'sympa_session',
> > $value, $expire;
> > + }else {
> > + $cookie = sprintf "%s=%s; Domain=%s; Path=/; Max-Age=%s",
> > 'sympa_session', $value, $http_domain, $expire;;
> > + }
> > +
> > + ## Return the cookie value
> > + return $cookie;
> > +}
> > +
> > +## returns Message Authentication Check code
> > +sub get_mac {
> > + my $email = shift ;
> > + my $secret = shift ;
> > + Sympa::Log::Syslog::do_log('debug3', "get_mac($email, $secret)");
> > +
> > + unless ($secret) {
> > + Sympa::Log::Syslog::do_log('err', 'get_mac : failure missing
> > server secret for cookie MD5 digest');
> > + return undef;
> > + }
> > + unless ($email) {
> > + Sympa::Log::Syslog::do_log('err', 'get_mac : failure missing
> > email adresse or cookie MD5 digest');
> > + return undef;
> > + }
> > +
> > +
> > +
> > + my $md5 = new Digest::MD5;
> > +
> > + $md5->reset;
> > + $md5->add($email.$secret);
> > +
> > + return substr( unpack("H*", $md5->digest) , -8 );
> > +
> > +}
> > +
> > +sub set_cookie_extern {
> > + my ($secret,$http_domain,%alt_emails) = @_ ;
> > + my $expiration;
> > + my $cookie;
> > + my $value;
> > +
> > + my @mails ;
> > + foreach my $mail (keys %alt_emails) {
> > + my $string = $mail.':'.$alt_emails{$mail};
> > + push(@mails,$string);
> > + }
> > + my $emails = join(',',@mails);
> > +
> > + $value = sprintf '%s&%s',$emails,&get_mac($emails,$secret);
> > +
> > + if ($http_domain eq 'localhost') {
> > + $http_domain="";
> > + }
> > +
> > + $cookie = new CGI::Cookie (-name => 'sympa_altemails',
> > + -value => $value,
> > + -expires => '+1y',
> > + -domain => $http_domain,
> > + -path => '/'
> > + );
> > + ## Send cookie to the client
> > + printf "Set-Cookie: %s\n", $cookie->as_string;
> > + #Sympa::Log::Syslog::do_log('notice',"set_cookie_extern :
> > %s",$cookie->as_string);
> > + return 1;
> > +}
> > +
> > +
> > +
> > +
> > +###############################
> > +# Subroutines to read cookies #
> > +###############################
> > +
> > +## Generic subroutine to get a cookie value
> > +sub generic_get_cookie {
> > + my $http_cookie = shift;
> > + my $cookie_name = shift;
> > +
> > + if ($http_cookie =~/\S+/g) {
> > + my %cookies = parse CGI::Cookie($http_cookie);
> > + foreach (keys %cookies) {
> > + my $cookie = $cookies{$_};
> > + next unless ($cookie->name eq $cookie_name);
> > + return ($cookie->value);
> > + }
> > + }
> > + return (undef);
> > +}
> > +
> > +## Returns user information extracted from the cookie
> > +sub check_cookie {
> > + my $http_cookie = shift;
> > + my $secret = shift;
> > +
> > + my $user = &generic_get_cookie($http_cookie, 'sympauser');
> > +
> > + my @values = split /:/, $user;
> > + if ($#values >= 1) {
> > + my ($email, $mac, $auth) = @values;
> > + $auth ||= 'classic';
> > +
> > + ## Check the MAC
> > + if (&get_mac($email,$secret) eq $mac) {
> > + return ($email, $auth);
> > + }
> > + }
> > +
> > + return undef;
> > +}
> > +
> > +sub check_cookie_extern {
> > + my ($http_cookie,$secret,$user_email) = @_;
> > +
> > + my $extern_value = &generic_get_cookie($http_cookie,
> > 'sympa_altemails');
> > +
> > + if ($extern_value =~ /^(\S+)&(\w+)$/) {
> > + return undef unless (&get_mac($1,$secret) eq $2) ;
> > +
> > + my %alt_emails ;
> > + foreach my $element (split(/,/,$1)){
> > + my @array = split(/:/,$element);
> > + $alt_emails{$array[0]} = $array[1];
> > + }
> > +
> > + my $e = lc($user_email);
> > + unless ($alt_emails{$e}) {
> > + return undef;
> > + }
> > + return (\%alt_emails);
> > + }
> > + return undef
> > +}
> > +
> > +1;
> > +
> > +
> > +
> > Copied: trunk/src/lib/wwslib.pm (from rev 10083,
> > trunk/wwsympa/wwslib.pm) (0 => 10085)
> > --- trunk/src/lib/wwslib.pm (rev 0)
> > +++ trunk/src/lib/wwslib.pm 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -0,0 +1,303 @@
> > +# wwslib.pm - This module includes functions used by wwsympa.fcgi
> > +# RCS Identication ; $Revision$ ; $Date$
> > +#
> > +# Sympa - SYsteme de Multi-Postage Automatique
> > +# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des
> > Universites
> > +# Copyright (c) 1997,1998, 1999 Institut Pasteur & Christophe Wolfhugel
> > +#
> > +# This program is free software; you can redistribute it and/or modify
> > +# it under the terms of the GNU General Public License as published by
> > +# the Free Software Foundation; either version 2 of the License, or
> > +# (at your option) any later version.
> > +#
> > +# This program is distributed in the hope that it will be useful,
> > +# but WITHOUT ANY WARRANTY; without even the implied warranty of
> > +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> > +# GNU General Public License for more details.
> > +#
> > +# You should have received a copy of the GNU General Public License
> > +# along with this program. If not, see <http://www.gnu.org/licenses/>.
> > +
> > +package wwslib;
> > +
> > +use Log;
> > +use Conf;
> > +use Sympa::Constants;
> > +
> > +## No longer used: Use List->get_option_title().
> > +%reception_mode = ('mail' => {'gettext_id' => 'standard (direct
> > reception)'},
> > + 'digest' => {'gettext_id' => 'digest MIME format'},
> > + 'digestplain' => {'gettext_id' => 'digest plain text
> > format'},
> > + 'summary' => {'gettext_id' => 'summary mode'},
> > + 'notice' => {'gettext_id' => 'notice mode'},
> > + 'txt' => {'gettext_id' => 'text-only mode'},
> > + 'html'=> {'gettext_id' => 'html-only mode'},
> > + 'urlize' => {'gettext_id' => 'urlize mode'},
> > + 'nomail' => {'gettext_id' => 'no mail (useful for
> > vacations)'},
> > + 'not_me' => {'gettext_id' => 'you do not receive your own
> > posts'}
> > + );
> > +
> > +## Cookie expiration periods with corresponding entry in NLS
> > +%cookie_period = (0 => {'gettext_id' => "session"},
> > + 10 => {'gettext_id' => "10 minutes"},
> > + 30 => {'gettext_id' => "30 minutes"},
> > + 60 => {'gettext_id' => "1 hour"},
> > + 360 => {'gettext_id' => "6 hours"},
> > + 1440 => {'gettext_id' => "1 day"},
> > + 10800 => {'gettext_id' => "1 week"},
> > + 43200 => {'gettext_id' => "30 days"});
> > +
> > +## No longer used: Use List->get_option_title().
> > +%visibility_mode = ('noconceal' => {'gettext_id' => "listed in the list
> > review page"},
> > + 'conceal' => {'gettext_id' => "concealed"}
> > + );
> > +
> > +## Filenames with corresponding entry in NLS set 15
> > +%filenames = ('welcome.tt2' => {'gettext_id' => "welcome
> > message"},
> > + 'bye.tt2' => {'gettext_id' => "unsubscribe
> > message"},
> > + 'removed.tt2' => {'gettext_id' => "deletion
> > message"},
> > + 'message.footer' => {'gettext_id' => "message footer"},
> > + 'message.header' => {'gettext_id' => "message header"},
> > + 'remind.tt2' => {'gettext_id' => "remind message"},
> > + 'reject.tt2' => {'gettext_id' => "editor rejection
> > message"},
> > + 'invite.tt2' => {'gettext_id' => "subscribing
> > invitation message"},
> > + 'helpfile.tt2' => {'gettext_id' => "help file"},
> > + 'lists.tt2' => {'gettext_id' => "directory of
> > lists"},
> > + 'global_remind.tt2' => {'gettext_id' => "global remind
> > message"},
> > + 'summary.tt2' => {'gettext_id' => "summary
> > message"},
> > + 'info' => {'gettext_id' => "list
> > description"},
> > + 'homepage' => {'gettext_id' => "list homepage"},
> > + 'create_list_request.tt2' => {'gettext_id' => "list creation
> > request message"},
> > + 'list_created.tt2' => {'gettext_id' => "list creation
> > notification message"},
> > + 'your_infected_msg.tt2' => {'gettext_id' => "virus infection
> > message"},
> > + 'list_aliases.tt2' => {'gettext_id' => "list aliases
> > template"}
> > + );
> > +
> > +%task_flavours = (
> > + 'daily' => {'gettext_id' => 'daily' },
> > + 'monthly' => {'gettext_id' => 'monthly' },
> > + 'weekly' => {'gettext_id' => 'weekly' },
> > + );
> > +
> > +## Defined in RFC 1893
> > +%bounce_status = ('1.0' => 'Other address status',
> > + '1.1' => 'Bad destination mailbox address',
> > + '1.2' => 'Bad destination system address',
> > + '1.3' => 'Bad destination mailbox address syntax',
> > + '1.4' => 'Destination mailbox address ambiguous',
> > + '1.5' => 'Destination mailbox address valid',
> > + '1.6' => 'Mailbox has moved',
> > + '1.7' => 'Bad sender\'s mailbox address syntax',
> > + '1.8' => 'Bad sender\'s system address',
> > + '2.0' => 'Other or undefined mailbox status',
> > + '2.1' => 'Mailbox disabled, not accepting messages',
> > + '2.2' => 'Mailbox full',
> > + '2.3' => 'Message length exceeds administrative limit',
> > + '2.4' => 'Mailing list expansion problem',
> > + '3.0' => 'Other or undefined mail system status',
> > + '3.1' => 'Mail system full',
> > + '3.2' => 'System not accepting network messages',
> > + '3.3' => 'System not capable of selected features',
> > + '3.4' => 'Message too big for system',
> > + '4.0' => 'Other or undefined network or routing status',
> > + '4.1' => 'No answer from host',
> > + '4.2' => 'Bad connection',
> > + '4.3' => 'Routing server failure',
> > + '4.4' => 'Unable to route',
> > + '4.5' => 'Network congestion',
> > + '4.6' => 'Routing loop detected',
> > + '4.7' => 'Delivery time expired',
> > + '5.0' => 'Other or undefined protocol status',
> > + '5.1' => 'Invalid command',
> > + '5.2' => 'Syntax error',
> > + '5.3' => 'Too many recipients',
> > + '5.4' => 'Invalid command arguments',
> > + '5.5' => 'Wrong protocol version',
> > + '6.0' => 'Other or undefined media error',
> > + '6.1' => 'Media not supported',
> > + '6.2' => 'Conversion required and prohibited',
> > + '6.3' => 'Conversion required but not supported',
> > + '6.4' => 'Conversion with loss performed',
> > + '6.5' => 'Conversion failed',
> > + '7.0' => 'Other or undefined security status',
> > + '7.1' => 'Delivery not authorized, message refused',
> > + '7.2' => 'Mailing list expansion prohibited',
> > + '7.3' => 'Security conversion required but not possible',
> > + '7.4' => 'Security features not supported',
> > + '7.5' => 'Cryptographic failure',
> > + '7.6' => 'Cryptographic algorithm not supported',
> > + '7.7' => 'Message integrity failure');
> > +
> > +
> > +
> > +## if Crypt::CipherSaber installed store the cipher object
> > +my $cipher;
> > +
> > +## Load WWSympa configuration file
> > +##sub load_config
> > +## MOVED: use Conf::load_wwsconf().
> > +
> > +## Load HTTPD MIME Types
> > +sub load_mime_types {
> > + my $types = {};
> > +
> > + @localisation = ('/etc/mime.types',
> > '/usr/local/apache/conf/mime.types',
> > + '/etc/httpd/conf/mime.types',Site->etc.'/mime.types');
> > +
> > + foreach my $loc (@localisation) {
> > + next unless (-r $loc);
> > +
> > + unless(open (CONF, $loc)) {
> > + Sympa::Log::Syslog::do_log('err',"load_mime_types: unable to open
> > $loc");
> > + return undef;
> > + }
> > + }
> > +
> > + while (<CONF>) {
> > + next if /^\s*\#/;
> > +
> > + if (/^(\S+)\s+(.+)\s*$/i) {
> > + my ($k, $v) = ($1, $2);
> > +
> > + my @extensions = split / /, $v;
> > +
> > + ## provides file extention, given the content-type
> > + if ($#extensions >= 0) {
> > + $types->{$k} = $extensions[0];
> > + }
> > +
> > + foreach my $ext (@extensions) {
> > + $types->{$ext} = $k;
> > + }
> > + next;
> > + }
> > + }
> > +
> > + close FILE;
> > + return $types;
> > +}
> > +
> > +## Returns user information extracted from the cookie
> > +sub get_email_from_cookie {
> > +# Sympa::Log::Syslog::do_log('debug', 'get_email_from_cookie');
> > + my $cookie = shift;
> > + my $secret = shift;
> > +
> > + my ($email, $auth) ;
> > +
> > + # Sympa::Log::Syslog::do_log('info',
> > "get_email_from_cookie($cookie,$secret)");
> > +
> > + unless (defined $secret) {
> > +
> > &report::reject_report_web('intern','cookie_error',{},'','','',$robot);
> > + Sympa::Log::Syslog::do_log('info', 'parameter cookie undefined,
> > authentication failure');
> > + }
> > +
> > + unless ($cookie) {
> > +
> > &report::reject_report_web('intern','cookie_error',$cookie,'get_email_from_cookie','','',$robot);
> > + Sympa::Log::Syslog::do_log('info', ' cookie undefined, authentication
> > failure');
> > + }
> > +
> > + ($email, $auth) = &cookielib::check_cookie ($cookie, $secret);
> > + unless ( $email) {
> > + &report::reject_report_web('user','auth_failed',{},'');
> > + Sympa::Log::Syslog::do_log('info', 'get_email_from_cookie: auth
> > failed for user %s', $email);
> > + return undef;
> > + }
> > +
> > + return ($email, $auth);
> > +}
> > +
> > +sub new_passwd {
> > +
> > + my $passwd;
> > + my $nbchar = int(rand 5) + 6;
> > + foreach my $i (0..$nbchar) {
> > + $passwd .= chr(int(rand 26) + ord('a'));
> > + }
> > +
> > + return 'init'.$passwd;
> > +}
> > +
> > +## Basic check of an email address
> > +sub valid_email {
> > + my $email = shift;
> > +
> > + $email =~ /^([\w\-\_\.\/\+\=]+|\".*\")\@[\w\-]+(\.[\w\-]+)+$/;
> > +}
> > +
> > +sub init_passwd {
> > + my ($email, $data) = @_;
> > +
> > + my ($passwd, $user);
> > +
> > + if (User::is_global_user($email)) {
> > + $user = User::get_global_user($email);
> > +
> > + $passwd = $user->{'password'};
> > +
> > + unless ($passwd) {
> > + $passwd = &new_passwd();
> > +
> > + unless ( User::update_global_user($email,
> > + {'password' => $passwd,
> > + 'lang' => $user->{'lang'} ||
> > $data->{'lang'}} )) {
> > +
> > &report::reject_report_web('intern','update_user_db_failed',{'user'=>$email},'','',$email,$robot);
> > + Sympa::Log::Syslog::do_log('info','init_passwd: update
> > failed');
> > + return undef;
> > + }
> > + }
> > + }else {
> > + $passwd = &new_passwd();
> > + unless ( User::add_global_user({'email' => $email,
> > + 'password' => $passwd,
> > + 'lang' => $data->{'lang'},
> > + 'gecos' => $data->{'gecos'}})) {
> > +
> > &report::reject_report_web('intern','add_user_db_failed',{'user'=>$email},'','',$email,$robot);
> > + Sympa::Log::Syslog::do_log('info','init_passwd: add failed');
> > + return undef;
> > + }
> > + }
> > +
> > + return 1;
> > +}
> > +
> > +sub get_my_url {
> > +
> > +
> > + my $return_url;
> > +
> > + ## Mod_ssl sets SSL_PROTOCOL ; apache-ssl sets SSL_PROTOCOL_VERSION
> > + if ($ENV{'HTTPS'} eq 'on') {
> > + $return_url = 'https';
> > + }else{
> > + $return_url = 'http';
> > + }
> > +
> > + $return_url .= '://'.&main::get_header_field('HTTP_HOST');
> > + $return_url .= ':'.$ENV{'SERVER_PORT'} unless (($ENV{'SERVER_PORT'}
> > eq '80')||($ENV{'SERVER_PORT'} eq '443'));
> > + $return_url .= $ENV{'REQUEST_URI'};
> > + return ($return_url);
> > +}
> > +
> > +# Uploade source file to the destination on the server
> > +sub upload_file_to_server {
> > + my $param = shift;
> > + Sympa::Log::Syslog::do_log('debug',"Uploading file from field %s to
> > destination %s",$param->{'file_field'},$param->{'destination'});
> > + my $fh;
> > + unless ($fh = $param->{'query'}->upload($param->{'file_field'})) {
> > + Sympa::Log::Syslog::do_log('debug',"Cannot upload file from field
> > $param->{'file_field'}");
> > + return undef;
> > + }
> > +
> > + unless (open FILE, ">:bytes", $param->{'destination'}) {
> > + Sympa::Log::Syslog::do_log('debug',"Cannot open file
> > $param->{'destination'} : $!");
> > + return undef;
> > + }
> > + while (<$fh>) {
> > + print FILE;
> > + }
> > + close FILE;
> > + return 1;
> > +}
> > +
> > +1;
> > Deleted: trunk/wwsympa/Auth.pm (10084 => 10085)
> > --- trunk/wwsympa/Auth.pm 2014-01-02 09:09:01 UTC (rev 10084)
> > +++ trunk/wwsympa/Auth.pm 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -1,575 +0,0 @@
> > -# Auth.pm - This module provides web authentication functions
> > -# RCS Identication ; $Revision$ ; $Date$
> > -#
> > -# Sympa - SYsteme de Multi-Postage Automatique
> > -# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des
> > Universites
> > -# Copyright (c) 1997,1998, 1999 Institut Pasteur & Christophe Wolfhugel
> > -#
> > -# This program is free software; you can redistribute it and/or modify
> > -# it under the terms of the GNU General Public License as published by
> > -# the Free Software Foundation; either version 2 of the License, or
> > -# (at your option) any later version.
> > -#
> > -# This program is distributed in the hope that it will be useful,
> > -# but WITHOUT ANY WARRANTY; without even the implied warranty of
> > -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> > -# GNU General Public License for more details.
> > -#
> > -# You should have received a copy of the GNU General Public License
> > -# along with this program. If not, see <http://www.gnu.org/licenses/>.
> > -
> > -package Auth;
> > -
> > -use Digest::MD5;
> > -
> > -use Language qw(gettext_strftime);
> > -
> > -#use Log;
> > -#use Conf;
> > -#use List; # not used
> > -use report;
> > -
> > -#use SDM;
> > -
> > -## return the password finger print (this proc allow futur replacement
> > of md5 by sha1 or ....)
> > -sub password_fingerprint {
> > -
> > - Sympa::Log::Syslog::do_log('debug', 'Auth::password_fingerprint');
> > -
> > - my $pwd = shift;
> > - if (Site->password_case eq 'insensitive') {
> > - return &tools::md5_fingerprint(lc($pwd));
> > - } else {
> > - return &tools::md5_fingerprint($pwd);
> > - }
> > -}
> > -
> > -## authentication : via email or uid
> > -sub check_auth {
> > - Sympa::Log::Syslog::do_log('debug2', '(%s, %s, ...)', @_);
> > - my $robot = Robot::clean_robot(shift);
> > - my $auth = shift; ## User email or UID
> > - my $pwd = shift; ## Password
> > -
> > - my ($canonic, $user);
> > -
> > - if (&tools::valid_email($auth)) {
> > - return authentication($robot, $auth, $pwd);
> > - } else {
> > - ## This is an UID
> > - foreach my $ldap (@{Site->auth_services->{$robot->domain}}) {
> > -
> > - # only ldap service are to be applied here
> > - next unless ($ldap->{'auth_type'} eq 'ldap');
> > -
> > - $canonic =
> > - ldap_authentication($robot, $ldap, $auth, $pwd, 'uid_filter');
> > - last if ($canonic); ## Stop at first match
> > - }
> > - if ($canonic) {
> > -
> > - unless ($user = User::get_global_user($canonic)) {
> > - $user = {'email' => $canonic};
> > - }
> > - return {
> > - 'user' => $user,
> > - 'auth' => 'ldap',
> > - 'alt_emails' => {$canonic => 'ldap'}
> > - };
> > -
> > - } else {
> > - &report::reject_report_web('user', 'incorrect_passwd', {})
> > - unless ($ENV{'SYMPA_SOAP'});
> > - Sympa::Log::Syslog::do_log('err', "Incorrect LDAP password");
> > - return undef;
> > - }
> > - }
> > -}
> > -
> > -## This subroutine if Sympa may use its native authentication for a
> > given user
> > -## It might not if no user_table paragraph is found in auth.conf or if
> > the regexp or
> > -## negative_regexp exclude this user
> > -## IN : robot, user email
> > -## OUT : boolean
> > -sub may_use_sympa_native_auth {
> > - my $robot = Robot::clean_robot(shift);
> > - my $user_email = shift;
> > -
> > - my $ok = 0;
> > - ## check each auth.conf paragrpah
> > - foreach my $auth_service (@{Site->auth_services->{$robot->domain}}) {
> > - next unless ($auth_service->{'auth_type'} eq 'user_table');
> > -
> > - next
> > - if ($auth_service->{'regexp'} &&
> > - ($user_email !~ /$auth_service->{'regexp'}/i));
> > - next
> > - if ($auth_service->{'negative_regexp'} &&
> > - ($user_email =~ /$auth_service->{'negative_regexp'}/i));
> > -
> > - $ok = 1;
> > - last;
> > - }
> > -
> > - return $ok;
> > -}
> > -
> > -sub authentication {
> > - Sympa::Log::Syslog::do_log('debug2', '(%s, %s, ...)', @_);
> > - my $robot = Robot::clean_robot(shift);
> > - my $email = shift;
> > - my $pwd = shift;
> > - my ($user, $canonic);
> > -
> > - unless ($user = User::get_global_user($email)) {
> > - $user = {'email' => $email};
> > - }
> > - unless ($user->{'password'}) {
> > - $user->{'password'} = '';
> > - }
> > -
> > - if ($user->{'wrong_login_count'} > $robot->max_wrong_password) {
> > -
> > - # too many wrong login attemp
> > - User::update_global_user($email,
> > - {wrong_login_count => $user->{'wrong_login_count'} + 1});
> > - &report::reject_report_web('user', 'too_many_wrong_login', {})
> > - unless ($ENV{'SYMPA_SOAP'});
> > - Sympa::Log::Syslog::do_log('err',
> > - 'login is blocked : too many wrong password submission for %s',
> > - $email);
> > - return undef;
> > - }
> > - foreach my $auth_service (@{Site->auth_services->{$robot->domain}}) {
> > - next if ($auth_service->{'auth_type'} eq 'authentication_info_url');
> > - next if ($email !~ /$auth_service->{'regexp'}/i);
> > - next
> > - if (($email =~ /$auth_service->{'negative_regexp'}/i) &&
> > - ($auth_service->{'negative_regexp'}));
> > -
> > - ## Only 'user_table' and 'ldap' backends will need that Sympa
> > collects the user passwords
> > - ## Other backends are Single Sign-On solutions
> > - if ($auth_service->{'auth_type'} eq 'user_table') {
> > - my $fingerprint = &password_fingerprint($pwd);
> > -
> > - if ($fingerprint eq $user->{'password'}) {
> > - User::update_global_user($email, {wrong_login_count => 0});
> > - return {
> > - 'user' => $user,
> > - 'auth' => 'classic',
> > - 'alt_emails' => {$email => 'classic'}
> > - };
> > - }
> > - } elsif ($auth_service->{'auth_type'} eq 'ldap') {
> > - if ($canonic = ldap_authentication(
> > - $robot, $auth_service, $email, $pwd, 'email_filter'
> > - )
> > - ) {
> > - unless ($user = User::get_global_user($canonic)) {
> > - $user = {'email' => $canonic};
> > - }
> > - User::update_global_user($canonic, {wrong_login_count => 0});
> > - return {
> > - 'user' => $user,
> > - 'auth' => 'ldap',
> > - 'alt_emails' => {$email => 'ldap'}
> > - };
> > - }
> > - }
> > - }
> > -
> > - # increment wrong login count.
> > - User::update_global_user($email,
> > - {wrong_login_count => $user->{'wrong_login_count'} + 1});
> > -
> > - &report::reject_report_web('user', 'incorrect_passwd', {})
> > - unless ($ENV{'SYMPA_SOAP'});
> > - Sympa::Log::Syslog::do_log('err', 'authentication: incorrect
> > password for user %s',
> > - $email);
> > -
> > - $param->{'init_email'} = $email;
> > - $param->{'escaped_init_email'} = &tools::escape_chars($email);
> > - return undef;
> > -}
> > -
> > -sub ldap_authentication {
> > - Sympa::Log::Syslog::do_log('debug2', '(%s, %s, %s, ...)', @_);
> > - my $robot = Robot::clean_robot(shift);
> > - my $ldap = shift;
> > - my $auth = shift;
> > - my $pwd = shift;
> > - my $whichfilter = shift;
> > - my ($mesg, $host, $ldap_passwd, $ldap_anonymous);
> > -
> > - unless ($robot->get_etc_filename('auth.conf')) {
> > - return undef;
> > - }
> > -
> > - ## No LDAP entry is defined in auth.conf
> > - if ($#{Site->auth_services->{$robot->domain}} < 0) {
> > - Sympa::Log::Syslog::do_log('notice', 'Skipping empty auth.conf');
> > - return undef;
> > - }
> > -
> > - # only ldap service are to be applied here
> > - return undef unless ($ldap->{'auth_type'} eq 'ldap');
> > -
> > - # skip ldap auth service if the an email address was provided
> > - # and this email address does not match the corresponding regexp
> > - return undef if ($auth =~ /@/ && $auth !~ /$ldap->{'regexp'}/i);
> > -
> > - my @alternative_conf = split(/,/,
> > $ldap->{'alternative_email_attribute'});
> > - my $attrs = $ldap->{'email_attribute'};
> > - my $filter = $ldap->{'get_dn_by_uid_filter'}
> > - if ($whichfilter eq 'uid_filter');
> > - $filter = $ldap->{'get_dn_by_email_filter'}
> > - if ($whichfilter eq 'email_filter');
> > - $filter =~ s/\[sender\]/$auth/ig;
> > -
> > - ## bind in order to have the user's DN
> > - my $param = &tools::dup_var($ldap);
> > - my $ds = new LDAPSource($param);
> > -
> > - unless (defined $ds && ($ldap_anonymous = $ds->connect())) {
> > - Sympa::Log::Syslog::do_log('err', "Unable to connect to the LDAP
> > server '%s'",
> > - $ldap->{'host'});
> > - return undef;
> > - }
> > -
> > - $mesg = $ldap_anonymous->search(
> > - base => $ldap->{'suffix'},
> > - filter => "$filter",
> > - scope => $ldap->{'scope'},
> > - timeout => $ldap->{'timeout'}
> > - );
> > -
> > - if ($mesg->count() == 0) {
> > - Sympa::Log::Syslog::do_log('notice',
> > - 'No entry in the Ldap Directory Tree of %s for %s',
> > - $ldap->{'host'}, $auth);
> > - $ds->disconnect();
> > - return undef;
> > - }
> > -
> > - my $refhash = $mesg->as_struct();
> > - my (@DN) = keys(%$refhash);
> > - $ds->disconnect();
> > -
> > - ## bind with the DN and the pwd
> > -
> > - ## Duplicate structure first
> > - ## Then set the bind_dn and password according to the current user
> > - $param = &tools::dup_var($ldap);
> > - $param->{'ldap_bind_dn'} = $DN[0];
> > - $param->{'ldap_bind_password'} = $pwd;
> > -
> > - $ds = new LDAPSource($param);
> > -
> > - unless (defined $ds && ($ldap_passwd = $ds->connect())) {
> > - Sympa::Log::Syslog::do_log('err', "Unable to connect to the LDAP
> > server '%s'",
> > - $param->{'host'});
> > - return undef;
> > - }
> > -
> > - $mesg = $ldap_passwd->search(
> > - base => $ldap->{'suffix'},
> > - filter => "$filter",
> > - scope => $ldap->{'scope'},
> > - timeout => $ldap->{'timeout'}
> > - );
> > -
> > - if ($mesg->count() == 0 || $mesg->code() != 0) {
> > - Sympa::Log::Syslog::do_log('notice', "No entry in the LDAP Directory
> > Tree of %s",
> > - $ldap->{'host'});
> > - $ds->disconnect();
> > - return undef;
> > - }
> > -
> > - ## To get the value of the canonic email and the alternative email
> > - my (@canonic_email, @alternative);
> > -
> > - ## Keep previous alt emails not from LDAP source
> > - my $previous = {};
> > - foreach my $alt (keys %{$param->{'alt_emails'}}) {
> > - $previous->{$alt} = $param->{'alt_emails'}{$alt}
> > - if ($param->{'alt_emails'}{$alt} ne 'ldap');
> > - }
> > - $param->{'alt_emails'} = {};
> > -
> > - my $entry = $mesg->entry(0);
> > - @canonic_email = $entry->get_value($attrs, 'alloptions' => 1);
> > - foreach my $email (@canonic_email) {
> > - my $e = lc($email);
> > - $param->{'alt_emails'}{$e} = 'ldap' if ($e);
> > - }
> > -
> > - foreach my $attribute_value (@alternative_conf) {
> > - @alternative = $entry->get_value($attribute_value, 'alloptions' => 1);
> > - foreach my $alter (@alternative) {
> > - my $a = lc($alter);
> > - $param->{'alt_emails'}{$a} = 'ldap' if ($a);
> > - }
> > - }
> > -
> > - ## Restore previous emails
> > - foreach my $alt (keys %{$previous}) {
> > - $param->{'alt_emails'}{$alt} = $previous->{$alt};
> > - }
> > -
> > - $ds->disconnect() or Sympa::Log::Syslog::do_log('notice', "unable to
> > unbind");
> > - Sympa::Log::Syslog::do_log('debug3', "canonic: $canonic_email[0]");
> > - ## If the identifier provided was a valid email, return the provided
> > email.
> > - ## Otherwise, return the canonical email guessed after the login.
> > - if (&tools::valid_email($auth) &&
> > !$robot->ldap_force_canonical_email) {
> > - return ($auth);
> > - } else {
> > - return lc($canonic_email[0]);
> > - }
> > -}
> > -
> > -# fetch user email using his cas net_id and the paragrapah number in
> > auth.conf
> > -## NOTE: This might be moved to Robot package.
> > -sub get_email_by_net_id {
> > - my $robot = Robot::clean_robot(shift);
> > - my $auth_id = shift;
> > - my $attributes = shift;
> > - Sympa::Log::Syslog::do_log('debug2', '(%s, %s, uid=%s)',
> > - $robot, $auth_id, $attributes->{'uid'});
> > -
> > - if (defined Site->auth_services->{$robot->domain}[$auth_id]
> > - {'internal_email_by_netid'}) {
> > - my $sso_config = @{Site->auth_services->{$robot->domain}}[$auth_id];
> > - my $netid_cookie = $sso_config->{'netid_http_header'};
> > -
> > - $netid_cookie =~ s/(\w+)/$attributes->{$1}/ig;
> > -
> > - $email =
> > - $robot->get_netidtoemail_db($netid_cookie,
> > - Site->auth_services->{$robot->domain}[$auth_id]{'service_id'});
> > -
> > - return $email;
> > - }
> > -
> > - my $ldap = @{Site->auth_services->{$robot->domain}}[$auth_id];
> > -
> > - my $param = &tools::dup_var($ldap);
> > - my $ds = new LDAPSource($param);
> > - my $ldap_anonymous;
> > -
> > - unless (defined $ds && ($ldap_anonymous = $ds->connect())) {
> > - Sympa::Log::Syslog::do_log('err', "Unable to connect to the LDAP
> > server '%s'",
> > - $ldap->{'ldap_host'});
> > - return undef;
> > - }
> > -
> > - my $filter = $ldap->{'ldap_get_email_by_uid_filter'};
> > - $filter =~ s/\[([\w-]+)\]/$attributes->{$1}/ig;
> > -
> > - # my @alternative_conf =
> > split(/,/,$ldap->{'alternative_email_attribute'});
> > -
> > - my $emails = $ldap_anonymous->search(
> > - base => $ldap->{'ldap_suffix'},
> > - filter => $filter,
> > - scope => $ldap->{'ldap_scope'},
> > - timeout => $ldap->{'ldap_timeout'},
> > - attrs => [$ldap->{'ldap_email_attribute'}],
> > - );
> > - my $count = $emails->count();
> > -
> > - if ($emails->count() == 0) {
> > - Sympa::Log::Syslog::do_log('notice', "No entry in the LDAP Directory
> > Tree of %s",
> > - $host);
> > - $ds->disconnect();
> > - return undef;
> > - }
> > -
> > - $ds->disconnect();
> > -
> > - ## return only the first attribute
> > - my @results = $emails->entries;
> > - foreach my $result (@results) {
> > - return (lc($result->get_value($ldap->{'ldap_email_attribute'})));
> > - }
> > -
> > -}
> > -
> > -# check trusted_application_name et trusted_application_password :
> > return 1 or undef;
> > -sub remote_app_check_password {
> > - my $trusted_application_name = shift;
> > - my $password = shift;
> > - my $robot = Robot::clean_robot(shift);
> > - Sympa::Log::Syslog::do_log('debug2', '(%s, ..., %s)',
> > $trusted_application_name, $robot);
> > -
> > - my $md5 = &tools::md5_fingerprint($password);
> > -
> > - my $vars;
> > -
> > - # seach entry for trusted_application in Conf
> > - my @trusted_apps;
> > -
> > - # select trusted_apps from robot context or sympa context
> > - @trusted_apps = @{$robot->trusted_applications};
> > -
> > - foreach my $application (@trusted_apps) {
> > -
> > - if (lc($application->{'name'}) eq lc($trusted_application_name)) {
> > - if ($md5 eq $application->{'md5password'}) {
> > -
> > -# Sympa::Log::Syslog::do_log('debug', 'Auth::remote_app_check_password :
> > authentication succeed for %s',$application->{'name'});
> > - my %proxy_for_vars;
> > - foreach my $varname (@{$application->{'proxy_for_variables'}})
> > - {
> > - $proxy_for_vars{$varname} = 1;
> > - }
> > - return (\%proxy_for_vars);
> > - } else {
> > - Sympa::Log::Syslog::do_log('info',
> > - 'Auth::remote_app_check_password: bad password from %s',
> > - $trusted_application_name);
> > - return undef;
> > - }
> > - }
> > - }
> > -
> > - # no matching application found
> > - Sympa::Log::Syslog::do_log('info',
> > - 'Auth::remote_app-check_password: unknown application name %s',
> > - $trusted_application_name);
> > - return undef;
> > -}
> > -
> > -# create new entry in one_time_ticket table using a rand as id so later
> > -# access is authenticated
> > -sub create_one_time_ticket {
> > - Sympa::Log::Syslog::do_log('debug2', '(%s, %s, %s, %s)', @_);
> > - my $email = shift;
> > - my $robot = Robot::clean_robot(shift);
> > - my $data_string = shift;
> > - my $remote_addr = shift;
> > - ## Value may be 'mail' if the IP address is not known
> > -
> > - my $ticket = &SympaSession::get_random();
> > -
> > - my $date = time;
> > - my $sth;
> > -
> > - unless (
> > - SDM::do_prepared_query(
> > - q{INSERT INTO one_time_ticket_table
> > - (ticket_one_time_ticket, robot_one_time_ticket,
> > - email_one_time_ticket, date_one_time_ticket, data_one_time_ticket,
> > - remote_addr_one_time_ticket, status_one_time_ticket)
> > - VALUES (?, ?, ?, ?, ?, ?, ?)},
> > - $ticket, $robot->domain,
> > - $email, time, $data_string,
> > - $remote_addr, 'open'
> > - )
> > - ) {
> > - Sympa::Log::Syslog::do_log(
> > - 'err',
> > - 'Unable to insert new one time ticket for user %s, robot %s in
> > the database',
> > - $email,
> > - $robot
> > - );
> > - return undef;
> > - }
> > - return $ticket;
> > -}
> > -
> > -# read one_time_ticket from table and remove it
> > -sub get_one_time_ticket {
> > - Sympa::Log::Syslog::do_log('debug2', '(%s, %s)', @_);
> > - my $robot = shift;
> > - my $ticket_number = shift;
> > - my $addr = shift;
> > -
> > - my $sth;
> > -
> > - unless (
> > - $sth = SDM::do_prepared_query(
> > - q{SELECT ticket_one_time_ticket AS ticket,
> > - robot_one_time_ticket AS robot,
> > - email_one_time_ticket AS email,
> > - date_one_time_ticket AS "date",
> > - data_one_time_ticket AS data,
> > - remote_addr_one_time_ticket AS remote_addr,
> > - status_one_time_ticket as status
> > - FROM one_time_ticket_table
> > - WHERE ticket_one_time_ticket = ? AND robot_one_time_ticket = ?},
> > - $ticket_number, $robot->domain
> > - )
> > - ) {
> > - Sympa::Log::Syslog::do_log('err',
> > - 'Unable to retrieve one time ticket %s from database',
> > - $ticket_number);
> > - return {'result' => 'error'};
> > - }
> > -
> > - my $ticket = $sth->fetchrow_hashref('NAME_lc');
> > - $sth->finish;
> > -
> > - unless ($ticket) {
> > - Sympa::Log::Syslog::do_log('info', 'Unable to find one time ticket
> > %s', $ticket);
> > - return {'result' => 'not_found'};
> > - }
> > -
> > - my $result;
> > - my $printable_date = gettext_strftime "%d %b %Y at %H:%M:%S",
> > - localtime($ticket->{'date'});
> > - my $lockout = $robot->one_time_ticket_lockout || 'open';
> > - my $lifetime =
> > - tools::duration_conv($robot->one_time_ticket_lifetime || 0);
> > -
> > - if ($lockout eq 'one_time' and $ticket->{'status'} ne 'open') {
> > - $result = 'closed';
> > - Sympa::Log::Syslog::do_log('info', 'ticket %s from %s has been used
> > before (%s)',
> > - $ticket_number, $ticket->{'email'}, $printable_date);
> > - } elsif ($lockout eq 'remote_addr' and
> > - $ticket->{'status'} ne $addr and
> > - $ticket->{'status'} ne 'open') {
> > - $result = 'closed';
> > - Sympa::Log::Syslog::do_log('info',
> > - 'ticket %s from %s refused because accessed by the other (%s)',
> > - $ticket_number, $ticket->{'email'}, $printable_date);
> > - } elsif ($lifetime and $ticket->{'date'} + $lifetime < time) {
> > - Sympa::Log::Syslog::do_log('info', 'ticket %s from %s refused because
> > expired (%s)',
> > - $ticket_number, $ticket->{'email'}, $printable_date);
> > - $result = 'expired';
> > - } else {
> > - $result = 'success';
> > - }
> > -
> > - if ($result eq 'success') {
> > - unless (
> > - $sth = SDM::do_prepared_query(
> > - q{UPDATE one_time_ticket_table
> > - SET status_one_time_ticket = ?
> > - WHERE ticket_one_time_ticket = ? AND robot_one_time_ticket = ?},
> > - $addr, $ticket_number, $robot->domain
> > - )
> > - ) {
> > - Sympa::Log::Syslog::do_log('err',
> > - 'Unable to set one time ticket %s status to %s',
> > - $ticket_number, $addr);
> > - } elsif (!$sth->rows) {
> > -
> > - # ticket may be removed by task.
> > - Sympa::Log::Syslog::do_log('info', 'Unable to find one time
> > ticket %s',
> > - $ticket_number);
> > - return {'result' => 'not_found'};
> > - }
> > - }
> > -
> > - Sympa::Log::Syslog::do_log('debug', 'ticket : %s; result : %s',
> > $ticket_number, $result);
> > - return {
> > - 'result' => $result,
> > - 'date' => $ticket->{'date'},
> > - 'email' => $ticket->{'email'},
> > - 'remote_addr' => $ticket->{'remote_addr'},
> > - 'robot' => $robot->domain,
> > - 'data' => $ticket->{'data'},
> > - 'status' => $ticket->{'status'}
> > - };
> > -}
> > -
> > -1;
> > Deleted: trunk/wwsympa/Challenge.pm (10084 => 10085)
> > --- trunk/wwsympa/Challenge.pm 2014-01-02 09:09:01 UTC (rev 10084)
> > +++ trunk/wwsympa/Challenge.pm 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -1,135 +0,0 @@
> > -# Challenge.pm - This module includes functions managing email challenges
> > -#
> > -# Sympa - SYsteme de Multi-Postage Automatique
> > -# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des
> > Universites
> > -# Copyright (c) 1997,1998, 1999 Institut Pasteur & Christophe Wolfhugel
> > -#
> > -# This program is free software; you can redistribute it and/or modify
> > -# it under the terms of the GNU General Public License as published by
> > -# the Free Software Foundation; either version 2 of the License, or
> > -# (at your option) any later version.
> > -#
> > -# This program is distributed in the hope that it will be useful,
> > -# but WITHOUT ANY WARRANTY; without even the implied warranty of
> > -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> > -# GNU General Public License for more details.
> > -#
> > -# You should have received a copy of the GNU General Public License
> > -# along with this program. If not, see <http://www.gnu.org/licenses/>.
> > -
> > -package Challenge;
> > -
> > -use strict;
> > -no strict "vars";
> > -
> > -use Digest::MD5;
> > -use POSIX;
> > -use CGI::Cookie;
> > -use Time::Local;
> > -
> > -use Log;
> > -use Conf;
> > -use SympaSession;
> > -use SDM;
> > -
> > -# this structure is used to define which session attributes are stored
> > in a dedicated database col where others are compiled in col
> > 'data_session'
> > -my %challenge_hard_attributes = ('id_challenge' => 1, 'date' => 1,
> > 'robot' => 1,'email' => 1, 'list' => 1);
> > -
> > -
> > -# create a challenge context and store it in challenge table
> > -sub create {
> > - my ($robot, $email, $context) = @_;
> > -
> > - Sympa::Log::Syslog::do_log('debug', 'Challenge::new(%s, %s, %s)',
> > $challenge_id, $email, $robot);
> > -
> > - my $challenge={};
> > -
> > - unless ($robot) {
> > - Sympa::Log::Syslog::do_log('err', 'Missing robot parameter, cannot
> > create challenge object') ;
> > - return undef;
> > - }
> > -
> > - unless ($email) {
> > - Sympa::Log::Syslog::do_log('err', 'Missing email parameter, cannot
> > create challenge object') ;
> > - return undef;
> > - }
> > -
> > - $challenge->{'id_challenge'} = &get_random();
> > - $challenge->{'email'} = $email;
> > - $challenge->{'date'} = time;
> > - $challenge->{'robot'} = $robot;
> > - $challenge->{'data'} = $context;
> > - return undef unless (&Challenge::store($challenge));
> > - return $challenge->{'id_challenge'}
> > -}
> > -
> > -
> > -
> > -sub load {
> > -
> > - my $id_challenge = shift;
> > -
> > - Sympa::Log::Syslog::do_log('debug', 'Challenge::load(%s)',
> > $id_challenge);
> > -
> > - unless ($challenge_id) {
> > - Sympa::Log::Syslog::do_log('err', 'Challenge::load() : internal
> > error, SympaSession::load called with undef id_challenge');
> > - return undef;
> > - }
> > -
> > - my $sth;
> > -
> > - unless($sth = &SDM::do_query("SELECT id_challenge AS id_challenge,
> > date_challenge AS 'date', remote_addr_challenge AS remote_addr,
> > robot_challenge AS robot, email_challenge AS email, data_challenge AS
> > data, hit_challenge AS hit, start_date_challenge AS start_date FROM
> > challenge_table WHERE id_challenge = %s", $cookie)) {
> > - Sympa::Log::Syslog::do_log('err','Unable to retrieve challenge %s
> > from database',$cookie);
> > - return undef;
> > - }
> > -
> > - my $challenge = $sth->fetchrow_hashref('NAME_lc');
> > -
> > - unless ($challenge) {
> > - return 'not_found';
> > - }
> > - my $challenge_datas;
> > -
> > - my %datas= &tools::string_2_hash($challenge->{'data'});
> > - foreach my $key (keys %datas) {$challenge_datas->{$key} =
> > $datas{$key};}
> > -
> > - $challenge_datas->{'id_challenge'} = $challenge->{'id_challenge'};
> > - $challenge_datas->{'date'} = $challenge->{'date'};
> > - $challenge_datas->{'robot'} = $challenge->{'robot'};
> > - $challenge_datas->{'email'} = $challenge->{'email'};
> > -
> > - Sympa::Log::Syslog::do_log('debug3', 'Challenge::load(): removing
> > existing challenge del_statement = %s',$del_statement);
> > - unless(&SDM::do_query("DELETE FROM challenge_table WHERE
> > (id_challenge=%s)",$id_challenge)) {
> > - Sympa::Log::Syslog::do_log('err','Unable to delete challenge %s from
> > database',$id_challenge);
> > - return undef;
> > - }
> > -
> > - return ('expired') if (time - $challenge_datas->{'date'} >=
> > &tools::duration_conv(Site->challenge_table_ttl));
> > - return ($challenge_datas);
> > -}
> > -
> > -
> > -sub store {
> > -
> > - my $challenge = shift;
> > - Sympa::Log::Syslog::do_log('debug', 'Challenge::store()');
> > -
> > - return undef unless ($challenge->{'id_challenge'});
> > -
> > - my %hash ;
> > - foreach my $var (keys %$challenge ) {
> > - next if ($challenge_hard_attributes{$var});
> > - next unless ($var);
> > - $hash{$var} = $challenge->{$var};
> > - }
> > - my $data_string = &tools::hash_2_string (\%hash);
> > - my $sth;
> > -
> > - unless(&SDM::do_query("INSERT INTO challenge_table (id_challenge,
> > date_challenge, robot_challenge, email_challenge, data_challenge) VALUES
> > ('%s','%s','%s','%s','%s'')",$challenge->{'id_challenge'},$challenge->{'date'},$challenge->{'robot'},$challenge->{'email'},$data_string))
> > {
> > - Sympa::Log::Syslog::do_log('err','Unable to store challenge %s
> > informations in database (robot: %s, user:
> > %s)',$challenge->{'id_challenge'},$challenge->{'robot'},$challenge->{'email'});
> > - return undef;
> > - }
> > -}
> > -
> > -1;
> > -
> > Modified: trunk/wwsympa/Makefile.am (10084 => 10085)
> > --- trunk/wwsympa/Makefile.am 2014-01-02 09:09:01 UTC (rev 10084)
> > +++ trunk/wwsympa/Makefile.am 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -26,9 +26,6 @@
> > wwsympa_wrapper_fcgi_SOURCES = wwsympa-wrapper.fcgi.c
> > wwsympa_wrapper_fcgi_CPPFLAGS = -DWWSYMPA=\"$(execcgidir)/wwsympa.fcgi\"
> >
> > -nobase_modules_DATA = wwslib.pm cookielib.pm Marc.pm Auth.pm \
> > - Marc/Search.pm SharedDocument.pm SympaSession.pm
> > -
> > default_DATA = mime.types
> >
> > EXTRA_DIST = $(default_DATA) $(nobase_modules_DATA) \
> > Deleted: trunk/wwsympa/Marc.pm (10084 => 10085)
> > --- trunk/wwsympa/Marc.pm 2014-01-02 09:09:01 UTC (rev 10084)
> > +++ trunk/wwsympa/Marc.pm 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -1,58 +0,0 @@
> > -package Marc;
> > -
> > -use strict;
> > -
> > -use Carp;
> > -
> > -our $AUTOLOAD;
> > -our $VERSION = "4.3";
> > -
> > -##------------------------------------------------------------------------##
> > -## Constructor
> > -
> > -sub new
> > -{
> > - my $class = shift;
> > - my $fields_ref = shift;
> > - my $self =
> > - {
> > - directory_labels => {},
> > - permitted => $fields_ref,
> > - sort_function => 'sub { $a cmp $b }',
> > - %$fields_ref,
> > - };
> > - $self->{permitted}->{sort_function} = 'sub { $a cmp $b }';
> > - bless $self,$class;
> > - return $self;
> > -}
> > -
> > -##------------------------------------------------------------------------##
> > -## The AUTOLOAD function allows for the dynamic creation of accessor
> > methods
> > -
> > -sub AUTOLOAD
> > -{
> > - my $self = shift;
> > - my $type = ref($self) or croak "$self is not an object";
> > - my $name = $AUTOLOAD;
> > -
> > - # DESTROY messages should never be propagated.
> > - return if $name =~ /::DESTROY$/;
> > - # Remove the package name.
> > - $name =~ s/^.*://;
> > -
> > - unless (exists($self->{permitted}->{$name}))
> > - {
> > - &message('arcsearch_marc_autoload_no_access');
> > - &wwslog('info','arcsearch_marc: Can not access %s field in
> > object of class %s', $name, $type);
> > - return undef;
> > - }
> > - if (@_)
> > - {
> > - return $self->{$name} = shift;
> > - }
> > - else
> > - {
> > - return $self->{$name};
> > - }
> > -}
> > -1;
> > Deleted: trunk/wwsympa/SharedDocument.pm (10084 => 10085)
> > --- trunk/wwsympa/SharedDocument.pm 2014-01-02 09:09:01 UTC (rev 10084)
> > +++ trunk/wwsympa/SharedDocument.pm 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -1,533 +0,0 @@
> > -# SharedDocument.pm - module to manipulate shared web documents
> > -# 
> > -
> > -#
> > -# Sympa - SYsteme de Multi-Postage Automatique
> > -# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des
> > Universites
> > -# Copyright (c) 1997,1998, 1999 Institut Pasteur & Christophe Wolfhugel
> > -#
> > -# This program is free software; you can redistribute it and/or modify
> > -# it under the terms of the GNU General Public License as published by
> > -# the Free Software Foundation; either version 2 of the License, or
> > -# (at your option) any later version.
> > -#
> > -# This program is distributed in the hope that it will be useful,
> > -# but WITHOUT ANY WARRANTY; without even the implied warranty of
> > -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> > -# GNU General Public License for more details.
> > -#
> > -# You should have received a copy of the GNU General Public License
> > -# along with this program. If not, see <http://www.gnu.org/licenses/>.
> > -
> > -package SharedDocument;
> > -
> > -use strict;
> > -
> > -#use Carp; # currently not used
> > -#use POSIX; # no longer used
> > -
> > -use tools;
> > -use Language qw(gettext_strftime);
> > -
> > -#use List; # not used
> > -use Log;
> > -
> > -## Creates a new object
> > -sub new {
> > - Sympa::Log::Syslog::do_log('debug2', '(%s, %s, %s, %s)', @_);
> > - my ($pkg, $list, $path, $param) = @_;
> > -
> > - my $email = $param->{'user'}{'email'};
> > -
> > - #$email ||= 'nobody';
> > - my $document = {};
> > -
> > - unless (ref($list) =~ /List/i) {
> > - Sympa::Log::Syslog::do_log('err', 'SharedDocument::new : incorrect
> > list parameter');
> > - return undef;
> > - }
> > -
> > - $document->{'root_path'} = $list->dir . '/shared';
> > -
> > - $document->{'path'} = &main::no_slash_end($path);
> > - $document->{'escaped_path'} =
> > - &tools::escape_chars($document->{'path'}, '/');
> > -
> > - ### Document isn't a description file
> > - if ($document->{'path'} =~ /\.desc/) {
> > - Sympa::Log::Syslog::do_log('err', "SharedDocument::new : %s :
> > description file",
> > - $document->{'path'});
> > - return undef;
> > - }
> > -
> > - ## absolute path
> > - # my $doc;
> > - $document->{'absolute_path'} = $document->{'root_path'};
> > - if ($document->{'path'}) {
> > - $document->{'absolute_path'} .= '/' . $document->{'path'};
> > - }
> > -
> > - ## Check access control
> > - &check_access_control($document, $param);
> > -
> > - ###############################
> > - ## The path has been checked ##
> > - ###############################
> > -
> > - ### Document exist ?
> > - unless (-r $document->{'absolute_path'}) {
> > - Sympa::Log::Syslog::do_log(
> > - 'err',
> > - "SharedDocument::new : unable to read %s : no such file or
> > directory",
> > - $document->{'absolute_path'}
> > - );
> > - return undef;
> > - }
> > -
> > - ### Document has non-size zero?
> > - unless (-s $document->{'absolute_path'}) {
> > - Sympa::Log::Syslog::do_log(
> > - 'err',
> > - "SharedDocument::new : unable to read %s : empty document",
> > - $document->{'absolute_path'}
> > - );
> > - return undef;
> > - }
> > -
> > - $document->{'visible_path'} =
> > - &main::make_visible_path($document->{'path'});
> > -
> > - ## Date
> > - my @info = stat $document->{'absolute_path'};
> > - $document->{'date'} = gettext_strftime "%d %b %Y", localtime
> > $info[9];
> > - $document->{'date_epoch'} = $info[9];
> > -
> > - # Size of the doc
> > - $document->{'size'} = (-s $document->{'absolute_path'}) / 1000;
> > -
> > - ## Filename
> > - my @tokens = split /\//, $document->{'path'};
> > - $document->{'filename'} = $document->{'visible_filename'} =
> > - $tokens[$#tokens];
> > -
> > - ## Moderated document
> > - if ($document->{'filename'} =~ /^\.(.*)(\.moderate)$/) {
> > - $document->{'moderate'} = 1;
> > - $document->{'visible_filename'} = $1;
> > - }
> > -
> > - $document->{'escaped_filename'} =
> > - &tools::escape_chars($document->{'filename'});
> > -
> > - ## Father dir
> > - if ($document->{'path'} =~ /^(([^\/]*\/)*)([^\/]+)$/) {
> > - $document->{'father_path'} = $1;
> > - } else {
> > - $document->{'father_path'} = '';
> > - }
> > - $document->{'escaped_father_path'} =
> > - &tools::escape_chars($document->{'father_path'}, '/');
> > -
> > - ### File, directory or URL ?
> > - if (!(-d $document->{'absolute_path'})) {
> > -
> > - if ($document->{'filename'} =~ /^\..*\.(\w+)\.moderate$/) {
> > - $document->{'file_extension'} = $1;
> > - } elsif ($document->{'filename'} =~ /^.*\.(\w+)$/) {
> > - $document->{'file_extension'} = $1;
> > - }
> > -
> > - if ($document->{'file_extension'} eq 'url') {
> > - $document->{'type'} = 'url';
> > - } else {
> > - $document->{'type'} = 'file';
> > - }
> > - } else {
> > - $document->{'type'} = 'directory';
> > - }
> > -
> > - ## Load .desc file unless root directory
> > - my $desc_file;
> > - if ($document->{'type'} eq 'directory') {
> > - $desc_file = $document->{'absolute_path'} . '/.desc';
> > - } else {
> > - if ($document->{'absolute_path'} =~ /^(([^\/]*\/)*)([^\/]+)$/) {
> > - $desc_file = $1 . '.desc.' . $3;
> > - } else {
> > - Sympa::Log::Syslog::do_log(
> > - 'err',
> > - "SharedDocument::new() : cannot determine desc file for %s",
> > - $document->{'absolute_path'}
> > - );
> > - return undef;
> > - }
> > - }
> > -
> > - if ($document->{'path'} && (-e $desc_file)) {
> > - my @info = stat $desc_file;
> > - $document->{'serial_desc'} = $info[9];
> > -
> > - my %desc_hash = &main::get_desc_file($desc_file);
> > - $document->{'owner'} = $desc_hash{'email'};
> > - $document->{'title'} = $desc_hash{'title'};
> > - $document->{'escaped_title'} =
> > - &tools::escape_html($document->{'title'});
> > -
> > - # Author
> > - if ($desc_hash{'email'}) {
> > - $document->{'author'} = $desc_hash{'email'};
> > - $document->{'author_mailto'} =
> > - &main::mailto($list, $desc_hash{'email'});
> > - $document->{'author_known'} = 1;
> > - }
> > - }
> > -
> > - ### File, directory or URL ?
> > - if ($document->{'type'} eq 'url') {
> > -
> > - $document->{'icon'} = &main::get_icon('url');
> > -
> > - open DOC, $document->{'absolute_path'};
> > - my $url = <DOC>;
> > - close DOC;
> > - chomp $url;
> > - $document->{'url'} = $url;
> > -
> > - if ($document->{'filename'} =~ /^(.+)\.url/) {
> > - $document->{'anchor'} = $1;
> > - }
> > - } elsif ($document->{'type'} eq 'file') {
> > -
> > - if (my $type = &main::get_mime_type($document->{'file_extension'})) {
> > -
> > - # type of the file and apache icon
> > - if ($type =~ /^([\w\-]+)\/([\w\-]+)$/) {
> > - my ($mimet, $subt) = ($1, $2);
> > - if ($subt) {
> > - if ($subt =~ /^octet-stream$/) {
> > - $mimet = 'octet-stream';
> > - $subt = 'binary';
> > - }
> > - $type = "$subt file";
> > - }
> > - $document->{'icon'} = &main::get_icon($mimet) ||
> > - &main::get_icon('unknown');
> > - }
> > - } else {
> > -
> > - # unknown file type
> > - $document->{'icon'} = &main::get_icon('unknown');
> > - }
> > -
> > - ## HTML file
> > - if ($document->{'file_extension'} =~ /^html?$/i) {
> > - $document->{'html'} = 1;
> > - $document->{'icon'} = &main::get_icon('text');
> > - }
> > -
> > - ## Directory
> > - } else {
> > -
> > - $document->{'icon'} = &main::get_icon('folder');
> > -
> > - # listing of all the shared documents of the directory
> > - unless (opendir DIR, $document->{'absolute_path'}) {
> > - Sympa::Log::Syslog::do_log(
> > - 'err',
> > - "SharedDocument::new() : cannot open %s : %s",
> > - $document->{'absolute_path'}, $!
> > - );
> > - return undef;
> > - }
> > -
> > - # array of entry of the directory DIR
> > - my @tmpdir = readdir DIR;
> > - closedir DIR;
> > -
> > - my $dir =
> > - &main::get_directory_content(\@tmpdir, $email, $list,
> > - $document->{'absolute_path'});
> > -
> > - foreach my $d (@{$dir}) {
> > -
> > - my $sub_document =
> > - new SharedDocument($list, $document->{'path'} . '/' . $d,
> > - $param);
> > - push @{$document->{'subdir'}}, $sub_document;
> > - }
> > - }
> > -
> > - $document->{'list'} = $list;
> > -
> > - ## Bless Message object
> > - bless $document, $pkg;
> > -
> > - return $document;
> > -}
> > -
> > -sub dump {
> > - my $self = shift;
> > - my $fd = shift;
> > -
> > - &tools::dump_var($self, 0, $fd);
> > -
> > -}
> > -
> > -sub dup {
> > - my $self = shift;
> > -
> > - my $copy = {};
> > -
> > - foreach my $k (keys %$self) {
> > - $copy->{$k} = $self->{$k};
> > - }
> > -
> > - return $copy;
> > -}
> > -
> > -## Regulars
> > -# read(/) = default (config list)
> > -# edit(/) = default (config list)
> > -# control(/) = not defined
> > -# read(A/B)= (read(A) && read(B)) ||
> > -# (author(A) || author(B))
> > -# edit = idem read
> > -# control (A/B) : author(A) || author(B)
> > -# + (set owner A/B) if (empty directory &&
> > -# control A)
> > -
> > -sub check_access_control {
> > -
> > - # Arguments:
> > - # (\%mode,$path)
> > - # if mode->{'read'} control access only for read
> > - # if mode->{'edit'} control access only for edit
> > - # if mode->{'control'} control access only for control
> > -
> > -# return the hash (
> > -# $result{'may'}{'read'} == $result{'may'}{'edit'} ==
> > $result{'may'}{'control'} if is_author else :
> > -# $result{'may'}{'read'} = 0 or 1 (right or not)
> > -# $result{'may'}{'edit'} = 0(not may edit) or 0.5(may edit with
> > moderation) or 1(may edit ) : it is not a boolean anymore
> > -# $result{'may'}{'control'} = 0 or 1 (right or not)
> > -# $result{'reason'}{'read'} = string for authorization_reject.tt2 when
> > may_read == 0
> > -# $result{'reason'}{'edit'} = string for authorization_reject.tt2 when
> > may_edit == 0
> > -# $result{'scenario'}{'read'} = scenario name for the document
> > -# $result{'scenario'}{'edit'} = scenario name for the document
> > -
> > - # Result
> > - my %result;
> > - $result{'reason'} = {};
> > -
> > - # Control
> > -
> > - # Arguments
> > - my $self = shift;
> > - my $param = shift;
> > -
> > - my $list = $self->{'list'};
> > -
> > - Sympa::Log::Syslog::do_log('debug', "check_access_control(%s)",
> > $self->{'path'});
> > -
> > - # Control for editing
> > - my $may_read = 1;
> > - my $why_not_read = '';
> > - my $may_edit = 1;
> > - my $why_not_edit = '';
> > -
> > - ## First check privileges on the root shared directory
> > - $result{'scenario'}{'read'} = $list->shared_doc->{'d_read'}{'name'};
> > - $result{'scenario'}{'edit'} = $list->shared_doc->{'d_edit'}{'name'};
> > -
> > - ## Privileged owner has all privileges
> > - if ($param->{'is_privileged_owner'}) {
> > - $result{'may'}{'read'} = 1;
> > - $result{'may'}{'edit'} = 1;
> > - $result{'may'}{'control'} = 1;
> > -
> > - $self->{'access'} = \%result;
> > - return 1;
> > - }
> > -
> > - # if not privileged owner
> > - if (1) {
> > - my $result = Scenario::request_action(
> > - $list,
> > - 'shared_doc.d_read',
> > - $param->{'auth_method'},
> > - { 'sender' => $param->{'user'}{'email'},
> > - 'remote_host' => $param->{'remote_host'},
> > - 'remote_addr' => $param->{'remote_addr'}
> > - }
> > - );
> > - my $action;
> > - if (ref($result) eq 'HASH') {
> > - $action = $result->{'action'};
> > - $why_not_read = $result->{'reason'};
> > - }
> > -
> > - $may_read = ($action =~ /do_it/i);
> > - }
> > -
> > - if (1) {
> > - my $result = Scenario::request_action(
> > - $list,
> > - 'shared_doc.d_edit',
> > - $param->{'auth_method'},
> > - { 'sender' => $param->{'user'}{'email'},
> > - 'remote_host' => $param->{'remote_host'},
> > - 'remote_addr' => $param->{'remote_addr'}
> > - }
> > - );
> > - my $action;
> > - if (ref($result) eq 'HASH') {
> > - $action = $result->{'action'};
> > - $why_not_edit = $result->{'reason'};
> > - }
> > -
> > - #edit = 0, 0.5 or 1
> > - $may_edit = &main::find_edit_mode($action);
> > - $why_not_edit = '' if ($may_edit);
> > - }
> > -
> > - ## Only authenticated users can edit files
> > - unless ($param->{'user'}{'email'}) {
> > - $may_edit = 0;
> > - $why_not_edit = 'not_authenticated';
> > - }
> > -
> > - my $current_path = $self->{'path'};
> > - my $current_document;
> > - my %desc_hash;
> > - my $user = $param->{'user'}{'email'} || 'nobody';
> > -
> > - while ($current_path ne "") {
> > -
> > - # no description file found yet
> > - my $def_desc_file = 0;
> > - my $desc_file;
> > -
> > - $current_path =~ /^(([^\/]*\/)*)([^\/]+)(\/?)$/;
> > - $current_document = $3;
> > - my $next_path = $1;
> > -
> > - # opening of the description file appropriated
> > - if (-d $self->{'root_path'} . '/' . $current_path) {
> > -
> > - # case directory
> > -
> > - # unless ($slash) {
> > - $current_path = $current_path . '/';
> > -
> > - # }
> > -
> > - if (-e "$self->{'root_path'}/$current_path.desc") {
> > - $desc_file =
> > - $self->{'root_path'} . '/' . $current_path . ".desc";
> > - $def_desc_file = 1;
> > - }
> > -
> > - } else {
> > -
> > - # case file
> > - if (-e "$self->{'root_path'}/$next_path.desc.$3") {
> > - $desc_file =
> > - $self->{'root_path'} . '/' . $next_path . ".desc." . $3;
> > - $def_desc_file = 1;
> > - }
> > - }
> > -
> > - if ($def_desc_file) {
> > -
> > - # a description file was found
> > - # loading of acces information
> > -
> > - %desc_hash = &main::get_desc_file($desc_file);
> > -
> > - ## Author has all privileges
> > - if ($user eq $desc_hash{'email'}) {
> > - $result{'may'}{'read'} = 1;
> > - $result{'may'}{'edit'} = 1;
> > - $result{'may'}{'control'} = 1;
> > -
> > - $self->{'access'} = \%result;
> > - return 1;
> > - }
> > -
> > - if (1) {
> > -
> > - my $result = Scenario::request_action(
> > - $list,
> > - 'shared_doc.d_read',
> > - $param->{'auth_method'},
> > - { 'sender' => $param->{'user'}{'email'},
> > - 'remote_host' => $param->{'remote_host'},
> > - 'remote_addr' => $param->{'remote_addr'},
> > - 'scenario' => $desc_hash{'read'}
> > - }
> > - );
> > - my $action;
> > - if (ref($result) eq 'HASH') {
> > - $action = $result->{'action'};
> > - $why_not_read = $result->{'reason'};
> > - }
> > -
> > - $may_read = $may_read && ($action =~ /do_it/i);
> > - $why_not_read = '' if ($may_read);
> > - }
> > -
> > - if (1) {
> > - my $result = Scenario::request_action(
> > - $list,
> > - 'shared_doc.d_edit',
> > - $param->{'auth_method'},
> > - { 'sender' => $param->{'user'}{'email'},
> > - 'remote_host' => $param->{'remote_host'},
> > - 'remote_addr' => $param->{'remote_addr'},
> > - 'scenario' => $desc_hash{'edit'}
> > - }
> > - );
> > - my $action_edit;
> > - if (ref($result) eq 'HASH') {
> > - $action_edit = $result->{'action'};
> > - $why_not_edit = $result->{'reason'};
> > - }
> > -
> > - # $may_edit = 0, 0.5 or 1
> > - my $may_action_edit = &main::find_edit_mode($action_edit);
> > - $may_edit = &main::merge_edit($may_edit, $may_action_edit);
> > - $why_not_edit = '' if ($may_edit);
> > -
> > - }
> > -
> > - ## Only authenticated users can edit files
> > - unless ($param->{'user'}{'email'}) {
> > - $may_edit = 0;
> > - $why_not_edit = 'not_authenticated';
> > - }
> > -
> > - unless (defined $result{'scenario'}{'read'}) {
> > - $result{'scenario'}{'read'} = $desc_hash{'read'};
> > - $result{'scenario'}{'edit'} = $desc_hash{'edit'};
> > - }
> > -
> > - }
> > -
> > - # truncate the path for the while
> > - $current_path = $next_path;
> > - }
> > -
> > - if (1) {
> > - $result{'may'}{'read'} = $may_read;
> > - $result{'reason'}{'read'} = $why_not_read;
> > - }
> > -
> > - if (1) {
> > - $result{'may'}{'edit'} = $may_edit;
> > - $result{'reason'}{'edit'} = $why_not_edit;
> > - }
> > -
> > - $self->{'access'} = \%result;
> > - return 1;
> > -}
> > -
> > -1;
> > Deleted: trunk/wwsympa/SympaSession.pm (10084 => 10085)
> > --- trunk/wwsympa/SympaSession.pm 2014-01-02 09:09:01 UTC (rev 10084)
> > +++ trunk/wwsympa/SympaSession.pm 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -1,796 +0,0 @@
> > -# SympaSession.pm - This module includes functions managing HTTP
> > sessions in Sympa
> > -#
> > -# Sympa - SYsteme de Multi-Postage Automatique
> > -# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des
> > Universites
> > -# Copyright (c) 1997,1998, 1999 Institut Pasteur & Christophe Wolfhugel
> > -#
> > -# This program is free software; you can redistribute it and/or modify
> > -# it under the terms of the GNU General Public License as published by
> > -# the Free Software Foundation; either version 2 of the License, or
> > -# (at your option) any later version.
> > -#
> > -# This program is distributed in the hope that it will be useful,
> > -# but WITHOUT ANY WARRANTY; without even the implied warranty of
> > -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> > -# GNU General Public License for more details.
> > -#
> > -# You should have received a copy of the GNU General Public License
> > -# along with this program. If not, see <http://www.gnu.org/licenses/>.
> > -
> > -package SympaSession;
> > -
> > -use strict;
> > -
> > -use CGI::Cookie;
> > -#use Digest::MD5; # no longer used
> > -#use POSIX; # no longer used
> > -#use Time::Local; # not used
> > -
> > -#use Conf; # no longer used
> > -#use Log; # used by SDM
> > -use SDM;
> > -
> > -# this structure is used to define which session attributes are stored
> > in a
> > -# dedicated database col where others are compiled in col 'data_session'
> > -my %session_hard_attributes = ('id_session' => 1,
> > - 'prev_id' => 1,
> > - 'date' => 1,
> > - 'refresh_date' => 1,
> > - 'remote_addr' => 1,
> > - 'robot' => 1,
> > - 'email' => 1,
> > - 'start_date' => 1,
> > - 'hit' => 1,
> > - 'new_session' => 1,
> > - );
> > -
> > -sub new {
> > - my $pkg = shift;
> > - my $robot = Robot::clean_robot(shift, 1); #FIXME: maybe a Site
> > object?
> > - my $context = shift || {};
> > -
> > - my $cookie = $context->{'cookie'};
> > - my $action = $context->{'action'};
> > - my $rss = $context->{'rss'};
> > - my $ajax = $context->{'ajax'};
> > - Sympa::Log::Syslog::do_log('debug2', '(%s, cookie=%s, action=%s)',
> > - $robot, $cookie, $action);
> > -
> > - my $self = {'robot' => $robot};
> > - bless $self => $pkg;
> > -
> > - # passive_session are session not stored in the database, they are
> > used
> > - # for crawler bots and action such as css, wsdl, ajax and rss
> > -
> > - if (tools::is_a_crawler($robot,
> > - {'user_agent_string' => $ENV{'HTTP_USER_AGENT'}})) {
> > - $self->{'is_a_crawler'} = 1;
> > - $self->{'passive_session'} = 1;
> > - }
> > - $self->{'passive_session'} = 1
> > - if $rss or $action eq 'wsdl' or $action eq 'css';
> > -
> > - # if a session cookie exists, try to restore an existing session,
> > don't
> > - # store sessions from bots
> > - if ($cookie and $self->{'passive_session'} != 1){
> > - my $status ;
> > - $status = $self->load($cookie);
> > - unless (defined $status) {
> > - return undef;
> > - }
> > - if ($status eq 'not_found') {
> > - # start a new session (may be a fake cookie)
> > - Sympa::Log::Syslog::do_log('info', 'ignoring unknown session
> > cookie "%s"',
> > - $cookie);
> > - return __PACKAGE__->new($robot);
> > - }
> > - } else {
> > - # create a new session context
> > - ## Tag this session as new, ie no data in the DB exist
> > - $self->{'new_session'} = 1;
> > - $self->{'id_session'} = get_random();
> > - $self->{'email'} = 'nobody';
> > - $self->{'remote_addr'} = $ENV{'REMOTE_ADDR'};
> > - $self->{'date'} = $self->{'start_date'} = $self->{'refresh_date'} =
> > - time;
> > - $self->{'hit'} = 1;
> > - ##$self->{'robot'} = $robot->name;
> > - $self->{'data'} = '';
> > - }
> > - return $self;
> > -}
> > -
> > -sub load {
> > - Sympa::Log::Syslog::do_log('debug2', '(%s, %s)', @_);
> > - my $self = shift;
> > - my $cookie = shift;
> > -
> > - unless ($cookie) {
> > - Sympa::Log::Syslog::do_log('err', 'internal error, undef id_session');
> > - return undef;
> > - }
> > -
> > - my $sth;
> > - my $id_session;
> > - my $is_old_session = 0;
> > -
> > - ## Load existing session.
> > - if ($cookie and $cookie =~ /^\d{,16}$/) {
> > - ## Compatibility: session by older releases of Sympa.
> > - $id_session = $cookie;
> > - $is_old_session = 1;
> > -
> > - ## Session by older releases of Sympa doesn't have refresh_date.
> > - unless ($sth = SDM::do_prepared_query(
> > - q{SELECT id_session AS id_session, id_session AS prev_id,
> > - date_session AS "date",
> > - remote_addr_session AS remote_addr,
> > - robot_session AS robot, email_session AS email,
> > - data_session AS data, hit_session AS hit,
> > - start_date_session AS start_date,
> > - date_session AS refresh_date
> > - FROM session_table
> > - WHERE robot_session = ? AND
> > - id_session = ? AND
> > - refresh_date_session IS NULL},
> > - $self->{'robot'}->name, $id_session
> > - )) {
> > - Sympa::Log::Syslog::do_log('err', 'Unable to load session %s',
> > $id_session);
> > - return undef;
> > - }
> > - } else {
> > - $id_session = decrypt_session_id($cookie);
> > - unless ($id_session) {
> > - Sympa::Log::Syslog::do_log('err', 'internal error, undef
> > id_session');
> > - return 'not_found';
> > - }
> > -
> > - ## Cookie may contain current or previous session ID.
> > - unless ($sth = SDM::do_prepared_query(
> > - q{SELECT id_session AS id_session, prev_id_session AS prev_id,
> > - date_session AS "date",
> > - remote_addr_session AS remote_addr,
> > - robot_session AS robot, email_session AS email,
> > - data_session AS data, hit_session AS hit,
> > - start_date_session AS start_date,
> > - refresh_date_session AS refresh_date
> > - FROM session_table
> > - WHERE robot_session = ? AND
> > - (id_session = ? AND prev_id_session IS NOT NULL OR
> > - prev_id_session = ?)},
> > - $self->{'robot'}->name, $id_session, $id_session
> > - )) {
> > - Sympa::Log::Syslog::do_log('err', 'Unable to load session %s',
> > $id_session);
> > - return undef;
> > - }
> > - }
> > -
> > - my $session = undef;
> > - my $new_session = undef;
> > - my $counter = 0;
> > - while ($new_session = $sth->fetchrow_hashref('NAME_lc')) {
> > - if ($counter > 0) {
> > - Sympa::Log::Syslog::do_log('err',
> > - 'The SQL statement did return more than one session');
> > - $session->{'email'} = '';
> > - last;
> > - }
> > - $session = $new_session;
> > - $counter++;
> > - }
> > -
> > - unless ($session) {
> > - return 'not_found';
> > - }
> > -
> > - ## Compatibility: Upgrade session by older releases of Sympa.
> > - if ($is_old_session) {
> > - SDM::do_prepared_query(
> > - q{UPDATE session_table
> > - SET prev_id_session = id_session
> > - WHERE id_session = ? AND prev_id_session IS NULL AND
> > - refresh_date_session IS NULL},
> > - $id_session
> > - );
> > - }
> > -
> > - my %datas = tools::string_2_hash($session->{'data'});
> > -
> > - ## canonicalize lang if possible.
> > - $datas{'lang'} =
> > - Language::CanonicLang($datas{'lang'}) || $datas{'lang'}
> > - if $datas{'lang'};
> > -
> > - foreach my $key (keys %datas) {$self->{$key} = $datas{$key};}
> > -
> > - $self->{'id_session'} = $session->{'id_session'};
> > - $self->{'prev_id'} = $session->{'prev_id'};
> > - $self->{'date'} = $session->{'date'};
> > - $self->{'start_date'} = $session->{'start_date'};
> > - $self->{'refresh_date'} = $session->{'refresh_date'};
> > - $self->{'hit'} = $session->{'hit'} +1 ;
> > - $self->{'remote_addr'} = $session->{'remote_addr'};
> > - ##$self->{'robot'} = $session->{'robot'};
> > - $self->{'email'} = $session->{'email'};
> > -
> > - return ($self);
> > -}
> > -
> > -## This method will both store the session information in the database
> > -sub store {
> > - Sympa::Log::Syslog::do_log('debug2', '(%s)', @_);
> > - my $self = shift;
> > -
> > - return undef unless $self->{'id_session'};
> > - # do not create a session in session table for crawlers;
> > - return if $self->{'is_a_crawler'};
> > - # do not create a session in session table for action such as RSS or
> > CSS
> > - # or wsdl that do not require this sophistication;
> > - return if $self->{'passive_session'};
> > -
> > - my %hash;
> > - foreach my $var (keys %$self ) {
> > - next if ($session_hard_attributes{$var});
> > - next unless ($var);
> > - $hash{$var} = $self->{$var};
> > - }
> > - my $data_string = tools::hash_2_string (\%hash);
> > - my $time = time;
> > -
> > - ## If this is a new session, then perform an INSERT
> > - if ($self->{'new_session'}) {
> > - ## Store the new session ID in the DB
> > - ## Previous session ID is set to be same as new session ID.
> > - unless (SDM::do_prepared_query(
> > - q{INSERT INTO session_table
> > - (id_session, prev_id_session,
> > - date_session, refresh_date_session,
> > - remote_addr_session, robot_session,
> > - email_session, start_date_session, hit_session,
> > - data_session)
> > - VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)},
> > - $self->{'id_session'}, $self->{'id_session'},
> > - $time, $time,
> > - $ENV{'REMOTE_ADDR'}, $self->{'robot'}->name,
> > - $self->{'email'}, $self->{'start_date'}, $self->{'hit'},
> > - $data_string
> > - )) {
> > - Sympa::Log::Syslog::do_log('err',
> > - 'Unable to add new session %s informations in database',
> > - $self->{'id_session'}
> > - );
> > - return undef;
> > - }
> > -
> > - $self->{'prev_id'} = $self->{'id_session'};
> > -
> > - } else {
> > - ## If the session already exists in DB, then perform an UPDATE
> > -
> > - ## Cookie may contain previous session ID.
> > - my $sth = SDM::do_prepared_query(
> > - q{SELECT id_session
> > - FROM session_table
> > - WHERE robot_session = ? AND prev_id_session = ?},
> > - $self->{'robot'}->name, $self->{'id_session'}
> > - );
> > - unless ($sth) {
> > - Sympa::Log::Syslog::do_log('err',
> > - 'Unable to update session information in database');
> > - return undef;
> > - }
> > - if ($sth->rows) {
> > - my $new_id = $sth->fetchrow;
> > - $sth->finish;
> > - if ($new_id) {
> > - $self->{'prev_id'} = $self->{'id_session'};
> > - $self->{'id_session'} = $new_id;
> > - }
> > - }
> > -
> > - ## Update the new session in the DB
> > - unless (SDM::do_prepared_query(
> > - q{UPDATE session_table
> > - SET date_session = ?, remote_addr_session = ?,
> > - robot_session = ?, email_session = ?,
> > - start_date_session = ?, hit_session = ?, data_session = ?
> > - WHERE robot_session = ? AND
> > - (id_session = ? AND prev_id_session IS NOT NULL OR
> > - prev_id_session = ?)},
> > - $time, $ENV{'REMOTE_ADDR'},
> > - $self->{'robot'}->name, $self->{'email'},
> > - $self->{'start_date'}, $self->{'hit'}, $data_string,
> > - $self->{'robot'}->name,
> > - $self->{'id_session'},
> > - $self->{'id_session'}
> > - )) {
> > - Sympa::Log::Syslog::do_log('err',
> > - 'Unable to update session %s information in database',
> > - $self->{'id_session'}
> > - );
> > - return undef;
> > - }
> > - }
> > -
> > - return 1;
> > -}
> > -
> > -## This method will renew the session ID
> > -sub renew {
> > - Sympa::Log::Syslog::do_log('debug2', '(%s)', @_);
> > - my $self = shift;
> > -
> > - return undef unless $self->{'id_session'};
> > - # do not create a session in session table for crawlers;
> > - return if $self->{'is_a_crawler'};
> > - # do not create a session in session table for action such as RSS or
> > CSS
> > - # or wsdl that do not require this sophistication;
> > - return if $self->{'passive_session'};
> > -
> > - my %hash;
> > - foreach my $var (keys %$self ) {
> > - next if ($session_hard_attributes{$var});
> > - next unless ($var);
> > - $hash{$var} = $self->{$var};
> > - }
> > - my $data_string = tools::hash_2_string(\%hash);
> > -
> > - my $sth;
> > - ## Cookie may contain previous session ID.
> > - $sth = SDM::do_prepared_query(
> > - q{SELECT id_session
> > - FROM session_table
> > - WHERE robot_session = ? AND prev_id_session = ?},
> > - $self->{'robot'}->name, $self->{'id_session'}
> > - );
> > - unless ($sth) {
> > - Sympa::Log::Syslog::do_log('err',
> > - 'Unable to update session information in database');
> > - return undef;
> > - }
> > - if ($sth->rows) {
> > - my $new_id = $sth->fetchrow;
> > - $sth->finish;
> > - if ($new_id) {
> > - $self->{'prev_id'} = $self->{'id_session'};
> > - $self->{'id_session'} = $new_id;
> > - }
> > - }
> > -
> > - ## Renew the session ID in order to prevent session hijacking
> > - my $new_id = get_random();
> > -
> > - ## Do refresh the session ID when remote address was changed or
> > refresh
> > - ## interval was past. Conditions also are checked by SQL so that
> > - ## simultaneous processes will be prevented renewing cookie.
> > - my $time = time;
> > - my $remote_addr = $ENV{'REMOTE_ADDR'};
> > - my $refresh_term;
> > - if (Site->cookie_refresh == 0) {
> > - $refresh_term = $time;
> > - } else {
> > - my $cookie_refresh = Site->cookie_refresh;
> > - $refresh_term =
> > - int($time - $cookie_refresh * 0.25 - rand($cookie_refresh * 0.5));
> > - }
> > - unless ($self->{'remote_addr'} ne $remote_addr or
> > - $self->{'refresh_date'} <= $refresh_term) {
> > - return 0;
> > - }
> > -
> > - ## First insert DB entry with new session ID,
> > - $sth = SDM::do_query(
> > - q{INSERT INTO session_table
> > - (id_session, prev_id_session,
> > - start_date_session, date_session, refresh_date_session,
> > - remote_addr_session, robot_session, email_session,
> > - hit_session, data_session)
> > - SELECT %s, id_session,
> > - start_date_session, date_session, %d,
> > - %s, robot_session, email_session,
> > - hit_session, data_session
> > - FROM session_table
> > - WHERE robot_session = %s AND
> > - (id_session = %s AND prev_id_session IS NOT NULL OR
> > - prev_id_session = %s) AND
> > - (remote_addr_session <> %s OR refresh_date_session <= %d)},
> > - SDM::quote($new_id),
> > - $time,
> > - SDM::quote($remote_addr),
> > - SDM::quote($self->{'robot'}->name),
> > - SDM::quote($self->{'id_session'}),
> > - SDM::quote($self->{'id_session'}),
> > - SDM::quote($remote_addr), $refresh_term
> > - );
> > - unless ($sth) {
> > - Sympa::Log::Syslog::do_log('err', 'Unable to renew session ID for
> > session %s',
> > - $self->{'id_session'});
> > - return undef;
> > - }
> > - unless ($sth->rows) {
> > - return 0;
> > - }
> > - ## Keep previous ID to prevent crosstalk, clearing grand-parent ID.
> > - SDM::do_prepared_query(
> > - q{UPDATE session_table
> > - SET prev_id_session = NULL
> > - WHERE robot_session = ? AND id_session = ?},
> > - $self->{'robot'}->name, $self->{'id_session'}
> > - );
> > - ## Remove record of grand-parent ID.
> > - SDM::do_prepared_query(
> > - q{DELETE FROM session_table
> > - WHERE id_session = ? AND prev_id_session IS NULL},
> > - $self->{'prev_id'}
> > - );
> > -
> > - ## Renew the session ID in order to prevent session hijacking
> > - Sympa::Log::Syslog::do_log('info',
> > - '[robot %s] [session %s] [client %s]%s new session %s',
> > - $self->{'robot'}->name, $self->{'id_session'}, $remote_addr,
> > - ($self->{'email'} ? sprintf(' [user %s]', $self->{'email'}) : ''),
> > - $new_id
> > - );
> > - $self->{'prev_id'} = $self->{'id_session'};
> > - $self->{'id_session'} = $new_id;
> > - $self->{'refresh_date'} = $time;
> > - $self->{'remote_addr'} = $remote_addr;
> > -
> > - return 1;
> > -}
> > -
> > -## remove old sessions from a particular robot or from all robots.
> > -## delay is a parameter in seconds
> > -sub purge_old_sessions {
> > - Sympa::Log::Syslog::do_log('debug2', '(%s)', @_);
> > - my $robot = Robot::clean_robot(shift, 1);
> > -
> > - my $delay = tools::duration_conv(Site->session_table_ttl);
> > - my $anonymous_delay =
> > - tools::duration_conv(Site->anonymous_session_table_ttl);
> > -
> > - unless ($delay) {
> > - Sympa::Log::Syslog::do_log('debug3', 'exit with delay null');
> > - return;
> > - }
> > - unless ($anonymous_delay) {
> > - Sympa::Log::Syslog::do_log('debug3', 'exit with anonymous delay
> > null');
> > - return;
> > - }
> > -
> > - my @sessions ;
> > - my $sth;
> > -
> > - my $condition = '';
> > - $condition = sprintf 'robot_session = %s', SDM::quote($robot->name)
> > - if ref $robot eq 'Robot';
> > - my $anonymous_condition = $condition;
> > -
> > - $condition .= sprintf '%s%d > date_session',
> > - ($condition ? ' AND ' : ''), time - $delay
> > - if $delay;
> > - $condition = " WHERE $condition"
> > - if $condition;
> > -
> > - $anonymous_condition .= sprintf '%s%d > date_session',
> > - ($anonymous_condition ? ' AND ' : ''), time - $anonymous_delay
> > - if $anonymous_delay;
> > - $anonymous_condition .= sprintf
> > - "%semail_session = 'nobody' AND hit_session = 1",
> > - ($anonymous_condition ? ' AND ' : '');
> > - $anonymous_condition = " WHERE $anonymous_condition"
> > - if $anonymous_condition;
> > -
> > - my $count_statement = q{SELECT count(*) FROM session_table%s};
> > - my $anonymous_count_statement = q{SELECT count(*) FROM
> > session_table%s};
> > - my $statement = q{DELETE FROM session_table%s};
> > - my $anonymous_statement = q{DELETE FROM session_table%s};
> > -
> > - unless ($sth = SDM::do_query($count_statement, $condition)) {
> > - Sympa::Log::Syslog::do_log('err', 'Unable to count old session for
> > robot %s', $robot);
> > - return undef;
> > - }
> > -
> > - my $total = $sth->fetchrow;
> > - if ($total == 0) {
> > - Sympa::Log::Syslog::do_log('debug3', 'no sessions to expire');
> > - }else{
> > - unless ($sth = SDM::do_query($statement, $condition)) {
> > - Sympa::Log::Syslog::do_log('err', 'Unable to purge old sessions
> > for robot %s',
> > - $robot);
> > - return undef;
> > - }
> > - }
> > - unless ($sth = SDM::do_query($anonymous_count_statement,
> > - $anonymous_condition)) {
> > - Sympa::Log::Syslog::do_log('err', 'Unable to count anonymous sessions
> > for robot %s',
> > - $robot);
> > - return undef;
> > - }
> > - my $anonymous_total = $sth->fetchrow;
> > - if ($anonymous_total == 0) {
> > - Sympa::Log::Syslog::do_log('debug3', 'no anonymous sessions to
> > expire');
> > - return $total ;
> > - }
> > - unless ($sth = SDM::do_query($anonymous_statement,
> > - $anonymous_condition)) {
> > - Sympa::Log::Syslog::do_log('err', 'Unable to purge anonymous sessions
> > for robot %s',
> > - $robot);
> > - return undef;
> > - }
> > - return $total+$anonymous_total;
> > -}
> > -
> > -
> > -## remove old one_time_ticket from a particular robot or from all
> > robots. delay is a parameter in seconds
> > -##
> > -sub purge_old_tickets {
> > - Sympa::Log::Syslog::do_log('debug2', '(%s)', @_);
> > - my $robot = Robot::clean_robot(shift, 1);
> > -
> > - my $delay = tools::duration_conv(Site->one_time_ticket_table_ttl);
> > - unless ($delay) {
> > - Sympa::Log::Syslog::do_log('debug3', 'exit with delay null');
> > - return;
> > - }
> > -
> > - my @tickets ;
> > - my $sth;
> > -
> > - my $condition = '';
> > - $condition = sprintf '%d > date_one_time_ticket', time - $delay
> > - if $delay;
> > - $condition .= sprintf '%srobot_one_time_ticket = %s',
> > - ($condition ? ' AND ' : ''), SDM::quote($robot->name)
> > - if ref $robot eq 'Robot';
> > - $condition = " WHERE $condition"
> > - if $condition;
> > -
> > - unless ($sth = SDM::do_query(
> > - q{SELECT count(*) FROM one_time_ticket_table%s},
> > - $condition
> > - )) {
> > - Sympa::Log::Syslog::do_log('err',
> > - 'Unable to count old one time tickets for robot %s', $robot);
> > - return undef;
> > - }
> > -
> > - my $total = $sth->fetchrow;
> > - if ($total == 0) {
> > - Sympa::Log::Syslog::do_log('debug3', 'no tickets to expire');
> > - }else{
> > - unless ($sth = SDM::do_query(
> > - q{DELETE FROM one_time_ticket_table%s},
> > - $condition
> > - )) {
> > - Sympa::Log::Syslog::do_log('err',
> > - 'Unable to delete expired one time tickets for robot %s',
> > - $robot);
> > - return undef;
> > - }
> > - }
> > - return $total;
> > -}
> > -
> > -# list sessions for $robot where last access is newer then $delay. List
> > is limited to connected users if $connected_only
> > -sub list_sessions {
> > - Sympa::Log::Syslog::do_log('debug2', '(%s, %s, %s)', @_);
> > - my $delay = shift;
> > - my $robot = Robot::clean_robot(shift, 1);
> > - my $connected_only = shift;
> > -
> > - my @sessions ;
> > - my $sth;
> > - my $time = time;
> > -
> > - my $condition = '';
> > - $condition = sprintf 'robot_session = %s', SDM::quote($robot->name)
> > - if ref $robot eq 'Robot';
> > - $condition .= sprintf '%s%d < date_session',
> > - ($condition ? ' AND ' : ''), $time - $delay
> > - if $delay;
> > - $condition .= sprintf "%semail_session <> 'nobody'",
> > - ($condition ? ' AND ' : '')
> > - if $connected_only eq 'on';
> > - $condition .= sprintf "%sprev_id_session IS NOT NULL",
> > - ($condition ? ' AND ' : '');
> > - $condition = " WHERE $condition"
> > - if $condition;
> > -
> > - unless ($sth = SDM::do_query(
> > - q{SELECT remote_addr_session, email_session, robot_session,
> > - date_session, start_date_session, hit_session
> > - FROM session_table%s},
> > - $condition
> > - )) {
> > - Sympa::Log::Syslog::do_log('err','Unable to get the list of sessions
> > for robot %s',
> > - $robot);
> > - return undef;
> > - }
> > -
> > - while (my $session = ($sth->fetchrow_hashref('NAME_lc'))) {
> > - $session->{'formated_date'} =
> > - Language::gettext_strftime("%d %b %y %H:%M",
> > localtime($session->{'date_session'}));
> > - $session->{'formated_start_date'} =
> > - Language::gettext_strftime ("%d %b %y %H:%M",
> > localtime($session->{'start_date_session'}));
> > -
> > - push @sessions, $session;
> > - }
> > -
> > - return \@sessions;
> > -}
> > -
> > -###############################
> > -# Subroutines to read cookies #
> > -###############################
> > -
> > -## Generic subroutine to get a cookie value
> > -sub get_session_cookie {
> > - my $http_cookie = shift;
> > -
> > - if ($http_cookie =~/\S+/g) {
> > - my %cookies = parse CGI::Cookie($http_cookie);
> > - foreach (keys %cookies) {
> > - my $cookie = $cookies{$_};
> > - next unless ($cookie->name eq 'sympa_session');
> > - return ($cookie->value);
> > - }
> > - }
> > -
> > - return (undef);
> > -}
> > -
> > -
> > -## Generic subroutine to set a cookie
> > -## Set user $email cookie, ckecksum use $secret,
> > expire=(now|session|#sec) domain=(localhost|<a domain>)
> > -sub set_cookie {
> > - Sympa::Log::Syslog::do_log('debug2', '(%s, %s, %s, %s)', @_);
> > - my ($self, $http_domain, $expires,$use_ssl) = @_ ;
> > -
> > - my $expiration;
> > - if ($expires =~ /now/i) {
> > - ## 10 years ago
> > - $expiration = '-10y';
> > - }else{
> > - $expiration = '+'.$expires.'m';
> > - }
> > -
> > - if ($http_domain eq 'localhost') {
> > - $http_domain="";
> > - }
> > -
> > - my $value = encrypt_session_id($self->{'id_session'});
> > -
> > - my $cookie;
> > - if ($expires =~ /session/i) {
> > - $cookie = new CGI::Cookie (-name => 'sympa_session',
> > - -value => $value,
> > - -domain => $http_domain,
> > - -path => '/',
> > - -secure => $use_ssl,
> > - -httponly => 1
> > - );
> > - }else {
> > - $cookie = new CGI::Cookie (-name => 'sympa_session',
> > - -value => $value,
> > - -expires => $expiration,
> > - -domain => $http_domain,
> > - -path => '/',
> > - -secure => $use_ssl,
> > - -httponly => 1
> > - );
> > - }
> > -
> > - ## Send cookie to the client
> > - printf "Set-Cookie: %s\n", $cookie->as_string;
> > - return 1;
> > -}
> > -
> > -# Build an HTTP cookie value to be sent to a SOAP client
> > -sub soap_cookie2 {
> > - my ($session_id, $http_domain, $expire) = @_;
> > - my $cookie;
> > - my $value;
> > -
> > - # WARNING : to check the cookie the SOAP services does not gives
> > - # all the cookie, only it's value so we need ':'
> > - $value = encrypt_session_id($session_id);
> > -
> > - ## With set-cookie2 max-age of 0 means removing the cookie
> > - ## Maximum cookie lifetime is the session
> > - $expire ||= 600; ## 10 minutes
> > -
> > - if ($http_domain eq 'localhost') {
> > - $cookie = CGI::Cookie->new(
> > - -name => 'sympa_session',
> > - -value => $value,
> > - -path => '/',
> > - );
> > - $cookie->max_age(time + $expire); # needs CGI >= 3.51.
> > - } else {
> > - $cookie = CGI::Cookie->new(
> > - -name => 'sympa_session',
> > - -value => $value,
> > - -domain => $http_domain,
> > - -path => '/',
> > - );
> > - $cookie->max_age(time + $expire); # needs CGI >= 3.51.
> > - }
> > -
> > - ## Return the cookie value
> > - return $cookie->as_string;
> > -}
> > -
> > -sub get_random {
> > - Sympa::Log::Syslog::do_log('debug3', '()');
> > - ## Concatenates 2 integers for a better entropy
> > - my $random = int(rand(10**7)).int(rand(10**7));
> > - $random =~ s/^0(\.|\,)//;
> > - return ($random)
> > -}
> > -
> > -## Return the session object content, as a hashref
> > -sub as_hashref {
> > - my $self = shift;
> > - my $data;
> > -
> > - foreach my $key (keys %{$self}) {
> > - if ($key eq 'robot') {
> > - $data->{$key} = $self->{'robot'}->name;
> > - } else {
> > - $data->{$key} = $self->{$key};
> > - }
> > - }
> > -
> > - return $data;
> > -}
> > -
> > -## Return 1 if the Session object corresponds to an anonymous session.
> > -sub is_anonymous {
> > - my $self = shift;
> > - if($self->{'email'} eq 'nobody' || $self->{'email'} eq '') {
> > - return 1;
> > - }else{
> > - return 0;
> > - }
> > -}
> > -
> > -## Generate cookie from session ID.
> > -sub encrypt_session_id {
> > - my $id_session = shift;
> > -
> > - return $id_session unless Site->cookie;
> > - my $cipher = tools::ciphersaber_installed();
> > - return $id_session unless $cipher;
> > -
> > - my $id_session_bin =
> > - pack 'nN', ($id_session >> 32), $id_session % (1 << 32);
> > - my $cookie_bin = $cipher->encrypt($id_session_bin);
> > - return sprintf '%*v02x', '', $cookie_bin;
> > -}
> > -
> > -## Get session ID from cookie.
> > -sub decrypt_session_id {
> > - my $cookie = shift;
> > -
> > - return $cookie unless Site->cookie;
> > - my $cipher = tools::ciphersaber_installed();
> > - return $cookie unless $cipher;
> > -
> > - return undef unless $cookie =~ /\A[0-9a-f]+\z/;
> > - my $cookie_bin = $cookie;
> > - $cookie_bin =~ s/([0-9a-f]{2})/sprintf '%c', hex("0x$1")/eg;
> > - my ($id_session_hi, $id_session_lo) =
> > - unpack 'nN', $cipher->decrypt($cookie_bin);
> > -
> > - return ($id_session_hi << 32) + $id_session_lo;
> > -}
> > -
> > -## Get unique ID
> > -sub get_id {
> > - my $self = shift;
> > - return '' unless $self->{'id_session'} and $self->{'robot'};
> > - return sprintf '%s@%s', $self->{'id_session'},
> > $self->{'robot'}->name;
> > -}
> > -
> > -1;
> > Deleted: trunk/wwsympa/cookielib.pm (10084 => 10085)
> > --- trunk/wwsympa/cookielib.pm 2014-01-02 09:09:01 UTC (rev 10084)
> > +++ trunk/wwsympa/cookielib.pm 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -1,206 +0,0 @@
> > -# cookielib.pm - This module includes functions managing HTTP cookies in
> > Sympa
> > -# RCS Identication ; $Revision$ ; $Date$
> > -#
> > -# Sympa - SYsteme de Multi-Postage Automatique
> > -# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des
> > Universites
> > -# Copyright (c) 1997,1998, 1999 Institut Pasteur & Christophe Wolfhugel
> > -#
> > -# This program is free software; you can redistribute it and/or modify
> > -# it under the terms of the GNU General Public License as published by
> > -# the Free Software Foundation; either version 2 of the License, or
> > -# (at your option) any later version.
> > -#
> > -# This program is distributed in the hope that it will be useful,
> > -# but WITHOUT ANY WARRANTY; without even the implied warranty of
> > -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> > -# GNU General Public License for more details.
> > -#
> > -# You should have received a copy of the GNU General Public License
> > -# along with this program. If not, see <http://www.gnu.org/licenses/>.
> > -
> > -package cookielib;
> > -
> > -use strict "vars";
> > -
> > -use Digest::MD5;
> > -use POSIX;
> > -use CGI::Cookie;
> > -
> > -use Log;
> > -
> > -## Generic subroutine to set a cookie
> > -sub generic_set_cookie {
> > - my %param = @_;
> > -
> > - my %cookie_param;
> > - foreach my $p ('name','value','expires','domain','path') {
> > - $cookie_param{'-'.$p} = $param{$p}; ## CGI::Cookie expects -param =>
> > value
> > - }
> > -
> > - if ($cookie_param{'-domain'} eq 'localhost') {
> > - $cookie_param{'-domain'} = '';
> > - }
> > -
> > - my $cookie = new CGI::Cookie(%cookie_param);
> > -
> > - ## Send cookie to the client
> > - printf "Set-Cookie: %s\n", $cookie->as_string;
> > -
> > - return 1;
> > -}
> > -
> > -
> > -
> > -# Sets an HTTP cookie to be sent to a SOAP client
> > -# OBSOLETED: Use SympaSession::soap_cookie2().
> > -sub set_cookie_soap {
> > - my ($session_id,$http_domain,$expire) = @_ ;
> > - my $cookie;
> > - my $value;
> > -
> > - # WARNING : to check the cookie the SOAP services does not gives
> > - # all the cookie, only it's value so we need ':'
> > - $value = $session_id;
> > -
> > - ## With set-cookie2 max-age of 0 means removing the cookie
> > - ## Maximum cookie lifetime is the session
> > - $expire ||= 600; ## 10 minutes
> > -
> > - if ($http_domain eq 'localhost') {
> > - $cookie = sprintf "%s=%s; Path=/; Max-Age=%s", 'sympa_session',
> > $value, $expire;
> > - }else {
> > - $cookie = sprintf "%s=%s; Domain=%s; Path=/; Max-Age=%s",
> > 'sympa_session', $value, $http_domain, $expire;;
> > - }
> > -
> > - ## Return the cookie value
> > - return $cookie;
> > -}
> > -
> > -## returns Message Authentication Check code
> > -sub get_mac {
> > - my $email = shift ;
> > - my $secret = shift ;
> > - Sympa::Log::Syslog::do_log('debug3', "get_mac($email, $secret)");
> > -
> > - unless ($secret) {
> > - Sympa::Log::Syslog::do_log('err', 'get_mac : failure missing
> > server secret for cookie MD5 digest');
> > - return undef;
> > - }
> > - unless ($email) {
> > - Sympa::Log::Syslog::do_log('err', 'get_mac : failure missing
> > email adresse or cookie MD5 digest');
> > - return undef;
> > - }
> > -
> > -
> > -
> > - my $md5 = new Digest::MD5;
> > -
> > - $md5->reset;
> > - $md5->add($email.$secret);
> > -
> > - return substr( unpack("H*", $md5->digest) , -8 );
> > -
> > -}
> > -
> > -sub set_cookie_extern {
> > - my ($secret,$http_domain,%alt_emails) = @_ ;
> > - my $expiration;
> > - my $cookie;
> > - my $value;
> > -
> > - my @mails ;
> > - foreach my $mail (keys %alt_emails) {
> > - my $string = $mail.':'.$alt_emails{$mail};
> > - push(@mails,$string);
> > - }
> > - my $emails = join(',',@mails);
> > -
> > - $value = sprintf '%s&%s',$emails,&get_mac($emails,$secret);
> > -
> > - if ($http_domain eq 'localhost') {
> > - $http_domain="";
> > - }
> > -
> > - $cookie = new CGI::Cookie (-name => 'sympa_altemails',
> > - -value => $value,
> > - -expires => '+1y',
> > - -domain => $http_domain,
> > - -path => '/'
> > - );
> > - ## Send cookie to the client
> > - printf "Set-Cookie: %s\n", $cookie->as_string;
> > - #Sympa::Log::Syslog::do_log('notice',"set_cookie_extern :
> > %s",$cookie->as_string);
> > - return 1;
> > -}
> > -
> > -
> > -
> > -
> > -###############################
> > -# Subroutines to read cookies #
> > -###############################
> > -
> > -## Generic subroutine to get a cookie value
> > -sub generic_get_cookie {
> > - my $http_cookie = shift;
> > - my $cookie_name = shift;
> > -
> > - if ($http_cookie =~/\S+/g) {
> > - my %cookies = parse CGI::Cookie($http_cookie);
> > - foreach (keys %cookies) {
> > - my $cookie = $cookies{$_};
> > - next unless ($cookie->name eq $cookie_name);
> > - return ($cookie->value);
> > - }
> > - }
> > - return (undef);
> > -}
> > -
> > -## Returns user information extracted from the cookie
> > -sub check_cookie {
> > - my $http_cookie = shift;
> > - my $secret = shift;
> > -
> > - my $user = &generic_get_cookie($http_cookie, 'sympauser');
> > -
> > - my @values = split /:/, $user;
> > - if ($#values >= 1) {
> > - my ($email, $mac, $auth) = @values;
> > - $auth ||= 'classic';
> > -
> > - ## Check the MAC
> > - if (&get_mac($email,$secret) eq $mac) {
> > - return ($email, $auth);
> > - }
> > - }
> > -
> > - return undef;
> > -}
> > -
> > -sub check_cookie_extern {
> > - my ($http_cookie,$secret,$user_email) = @_;
> > -
> > - my $extern_value = &generic_get_cookie($http_cookie,
> > 'sympa_altemails');
> > -
> > - if ($extern_value =~ /^(\S+)&(\w+)$/) {
> > - return undef unless (&get_mac($1,$secret) eq $2) ;
> > -
> > - my %alt_emails ;
> > - foreach my $element (split(/,/,$1)){
> > - my @array = split(/:/,$element);
> > - $alt_emails{$array[0]} = $array[1];
> > - }
> > -
> > - my $e = lc($user_email);
> > - unless ($alt_emails{$e}) {
> > - return undef;
> > - }
> > - return (\%alt_emails);
> > - }
> > - return undef
> > -}
> > -
> > -1;
> > -
> > -
> > -
> > Deleted: trunk/wwsympa/wwslib.pm (10084 => 10085)
> > --- trunk/wwsympa/wwslib.pm 2014-01-02 09:09:01 UTC (rev 10084)
> > +++ trunk/wwsympa/wwslib.pm 2014-01-02 09:16:17 UTC (rev 10085)
> > @@ -1,303 +0,0 @@
> > -# wwslib.pm - This module includes functions used by wwsympa.fcgi
> > -# RCS Identication ; $Revision$ ; $Date$
> > -#
> > -# Sympa - SYsteme de Multi-Postage Automatique
> > -# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des
> > Universites
> > -# Copyright (c) 1997,1998, 1999 Institut Pasteur & Christophe Wolfhugel
> > -#
> > -# This program is free software; you can redistribute it and/or modify
> > -# it under the terms of the GNU General Public License as published by
> > -# the Free Software Foundation; either version 2 of the License, or
> > -# (at your option) any later version.
> > -#
> > -# This program is distributed in the hope that it will be useful,
> > -# but WITHOUT ANY WARRANTY; without even the implied warranty of
> > -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> > -# GNU General Public License for more details.
> > -#
> > -# You should have received a copy of the GNU General Public License
> > -# along with this program. If not, see <http://www.gnu.org/licenses/>.
> > -
> > -package wwslib;
> > -
> > -use Log;
> > -use Conf;
> > -use Sympa::Constants;
> > -
> > -## No longer used: Use List->get_option_title().
> > -%reception_mode = ('mail' => {'gettext_id' => 'standard (direct
> > reception)'},
> > - 'digest' => {'gettext_id' => 'digest MIME format'},
> > - 'digestplain' => {'gettext_id' => 'digest plain text
> > format'},
> > - 'summary' => {'gettext_id' => 'summary mode'},
> > - 'notice' => {'gettext_id' => 'notice mode'},
> > - 'txt' => {'gettext_id' => 'text-only mode'},
> > - 'html'=> {'gettext_id' => 'html-only mode'},
> > - 'urlize' => {'gettext_id' => 'urlize mode'},
> > - 'nomail' => {'gettext_id' => 'no mail (useful for
> > vacations)'},
> > - 'not_me' => {'gettext_id' => 'you do not receive your own
> > posts'}
> > - );
> > -
> > -## Cookie expiration periods with corresponding entry in NLS
> > -%cookie_period = (0 => {'gettext_id' => "session"},
> > - 10 => {'gettext_id' => "10 minutes"},
> > - 30 => {'gettext_id' => "30 minutes"},
> > - 60 => {'gettext_id' => "1 hour"},
> > - 360 => {'gettext_id' => "6 hours"},
> > - 1440 => {'gettext_id' => "1 day"},
> > - 10800 => {'gettext_id' => "1 week"},
> > - 43200 => {'gettext_id' => "30 days"});
> > -
> > -## No longer used: Use List->get_option_title().
> > -%visibility_mode = ('noconceal' => {'gettext_id' => "listed in the list
> > review page"},
> > - 'conceal' => {'gettext_id' => "concealed"}
> > - );
> > -
> > -## Filenames with corresponding entry in NLS set 15
> > -%filenames = ('welcome.tt2' => {'gettext_id' => "welcome
> > message"},
> > - 'bye.tt2' => {'gettext_id' => "unsubscribe
> > message"},
> > - 'removed.tt2' => {'gettext_id' => "deletion
> > message"},
> > - 'message.footer' => {'gettext_id' => "message footer"},
> > - 'message.header' => {'gettext_id' => "message header"},
> > - 'remind.tt2' => {'gettext_id' => "remind message"},
> > - 'reject.tt2' => {'gettext_id' => "editor rejection
> > message"},
> > - 'invite.tt2' => {'gettext_id' => "subscribing
> > invitation message"},
> > - 'helpfile.tt2' => {'gettext_id' => "help file"},
> > - 'lists.tt2' => {'gettext_id' => "directory of
> > lists"},
> > - 'global_remind.tt2' => {'gettext_id' => "global remind
> > message"},
> > - 'summary.tt2' => {'gettext_id' => "summary
> > message"},
> > - 'info' => {'gettext_id' => "list
> > description"},
> > - 'homepage' => {'gettext_id' => "list homepage"},
> > - 'create_list_request.tt2' => {'gettext_id' => "list creation
> > request message"},
> > - 'list_created.tt2' => {'gettext_id' => "list creation
> > notification message"},
> > - 'your_infected_msg.tt2' => {'gettext_id' => "virus infection
> > message"},
> > - 'list_aliases.tt2' => {'gettext_id' => "list aliases
> > template"}
> > - );
> > -
> > -%task_flavours = (
> > - 'daily' => {'gettext_id' => 'daily' },
> > - 'monthly' => {'gettext_id' => 'monthly' },
> > - 'weekly' => {'gettext_id' => 'weekly' },
> > - );
> > -
> > -## Defined in RFC 1893
> > -%bounce_status = ('1.0' => 'Other address status',
> > - '1.1' => 'Bad destination mailbox address',
> > - '1.2' => 'Bad destination system address',
> > - '1.3' => 'Bad destination mailbox address syntax',
> > - '1.4' => 'Destination mailbox address ambiguous',
> > - '1.5' => 'Destination mailbox address valid',
> > - '1.6' => 'Mailbox has moved',
> > - '1.7' => 'Bad sender\'s mailbox address syntax',
> > - '1.8' => 'Bad sender\'s system address',
> > - '2.0' => 'Other or undefined mailbox status',
> > - '2.1' => 'Mailbox disabled, not accepting messages',
> > - '2.2' => 'Mailbox full',
> > - '2.3' => 'Message length exceeds administrative limit',
> > - '2.4' => 'Mailing list expansion problem',
> > - '3.0' => 'Other or undefined mail system status',
> > - '3.1' => 'Mail system full',
> > - '3.2' => 'System not accepting network messages',
> > - '3.3' => 'System not capable of selected features',
> > - '3.4' => 'Message too big for system',
> > - '4.0' => 'Other or undefined network or routing status',
> > - '4.1' => 'No answer from host',
> > - '4.2' => 'Bad connection',
> > - '4.3' => 'Routing server failure',
> > - '4.4' => 'Unable to route',
> > - '4.5' => 'Network congestion',
> > - '4.6' => 'Routing loop detected',
> > - '4.7' => 'Delivery time expired',
> > - '5.0' => 'Other or undefined protocol status',
> > - '5.1' => 'Invalid command',
> > - '5.2' => 'Syntax error',
> > - '5.3' => 'Too many recipients',
> > - '5.4' => 'Invalid command arguments',
> > - '5.5' => 'Wrong protocol version',
> > - '6.0' => 'Other or undefined media error',
> > - '6.1' => 'Media not supported',
> > - '6.2' => 'Conversion required and prohibited',
> > - '6.3' => 'Conversion required but not supported',
> > - '6.4' => 'Conversion with loss performed',
> > - '6.5' => 'Conversion failed',
> > - '7.0' => 'Other or undefined security status',
> > - '7.1' => 'Delivery not authorized, message refused',
> > - '7.2' => 'Mailing list expansion prohibited',
> > - '7.3' => 'Security conversion required but not possible',
> > - '7.4' => 'Security features not supported',
> > - '7.5' => 'Cryptographic failure',
> > - '7.6' => 'Cryptographic algorithm not supported',
> > - '7.7' => 'Message integrity failure');
> > -
> > -
> > -
> > -## if Crypt::CipherSaber installed store the cipher object
> > -my $cipher;
> > -
> > -## Load WWSympa configuration file
> > -##sub load_config
> > -## MOVED: use Conf::load_wwsconf().
> > -
> > -## Load HTTPD MIME Types
> > -sub load_mime_types {
> > - my $types = {};
> > -
> > - @localisation = ('/etc/mime.types',
> > '/usr/local/apache/conf/mime.types',
> > - '/etc/httpd/conf/mime.types',Site->etc.'/mime.types');
> > -
> > - foreach my $loc (@localisation) {
> > - next unless (-r $loc);
> > -
> > - unless(open (CONF, $loc)) {
> > - Sympa::Log::Syslog::do_log('err',"load_mime_types: unable to open
> > $loc");
> > - return undef;
> > - }
> > - }
> > -
> > - while (<CONF>) {
> > - next if /^\s*\#/;
> > -
> > - if (/^(\S+)\s+(.+)\s*$/i) {
> > - my ($k, $v) = ($1, $2);
> > -
> > - my @extensions = split / /, $v;
> > -
> > - ## provides file extention, given the content-type
> > - if ($#extensions >= 0) {
> > - $types->{$k} = $extensions[0];
> > - }
> > -
> > - foreach my $ext (@extensions) {
> > - $types->{$ext} = $k;
> > - }
> > - next;
> > - }
> > - }
> > -
> > - close FILE;
> > - return $types;
> > -}
> > -
> > -## Returns user information extracted from the cookie
> > -sub get_email_from_cookie {
> > -# Sympa::Log::Syslog::do_log('debug', 'get_email_from_cookie');
> > - my $cookie = shift;
> > - my $secret = shift;
> > -
> > - my ($email, $auth) ;
> > -
> > - # Sympa::Log::Syslog::do_log('info',
> > "get_email_from_cookie($cookie,$secret)");
> > -
> > - unless (defined $secret) {
> > -
> > &report::reject_report_web('intern','cookie_error',{},'','','',$robot);
> > - Sympa::Log::Syslog::do_log('info', 'parameter cookie undefined,
> > authentication failure');
> > - }
> > -
> > - unless ($cookie) {
> > -
> > &report::reject_report_web('intern','cookie_error',$cookie,'get_email_from_cookie','','',$robot);
> > - Sympa::Log::Syslog::do_log('info', ' cookie undefined, authentication
> > failure');
> > - }
> > -
> > - ($email, $auth) = &cookielib::check_cookie ($cookie, $secret);
> > - unless ( $email) {
> > - &report::reject_report_web('user','auth_failed',{},'');
> > - Sympa::Log::Syslog::do_log('info', 'get_email_from_cookie: auth
> > failed for user %s', $email);
> > - return undef;
> > - }
> > -
> > - return ($email, $auth);
> > -}
> > -
> > -sub new_passwd {
> > -
> > - my $passwd;
> > - my $nbchar = int(rand 5) + 6;
> > - foreach my $i (0..$nbchar) {
> > - $passwd .= chr(int(rand 26) + ord('a'));
> > - }
> > -
> > - return 'init'.$passwd;
> > -}
> > -
> > -## Basic check of an email address
> > -sub valid_email {
> > - my $email = shift;
> > -
> > - $email =~ /^([\w\-\_\.\/\+\=]+|\".*\")\@[\w\-]+(\.[\w\-]+)+$/;
> > -}
> > -
> > -sub init_passwd {
> > - my ($email, $data) = @_;
> > -
> > - my ($passwd, $user);
> > -
> > - if (User::is_global_user($email)) {
> > - $user = User::get_global_user($email);
> > -
> > - $passwd = $user->{'password'};
> > -
> > - unless ($passwd) {
> > - $passwd = &new_passwd();
> > -
> > - unless ( User::update_global_user($email,
> > - {'password' => $passwd,
> > - 'lang' => $user->{'lang'} ||
> > $data->{'lang'}} )) {
> > -
> > &report::reject_report_web('intern','update_user_db_failed',{'user'=>$email},'','',$email,$robot);
> > - Sympa::Log::Syslog::do_log('info','init_passwd: update
> > failed');
> > - return undef;
> > - }
> > - }
> > - }else {
> > - $passwd = &new_passwd();
> > - unless ( User::add_global_user({'email' => $email,
> > - 'password' => $passwd,
> > - 'lang' => $data->{'lang'},
> > - 'gecos' => $data->{'gecos'}})) {
> > -
> > &report::reject_report_web('intern','add_user_db_failed',{'user'=>$email},'','',$email,$robot);
> > - Sympa::Log::Syslog::do_log('info','init_passwd: add failed');
> > - return undef;
> > - }
> > - }
> > -
> > - return 1;
> > -}
> > -
> > -sub get_my_url {
> > -
> > -
> > - my $return_url;
> > -
> > - ## Mod_ssl sets SSL_PROTOCOL ; apache-ssl sets SSL_PROTOCOL_VERSION
> > - if ($ENV{'HTTPS'} eq 'on') {
> > - $return_url = 'https';
> > - }else{
> > - $return_url = 'http';
> > - }
> > -
> > - $return_url .= '://'.&main::get_header_field('HTTP_HOST');
> > - $return_url .= ':'.$ENV{'SERVER_PORT'} unless (($ENV{'SERVER_PORT'}
> > eq '80')||($ENV{'SERVER_PORT'} eq '443'));
> > - $return_url .= $ENV{'REQUEST_URI'};
> > - return ($return_url);
> > -}
> > -
> > -# Uploade source file to the destination on the server
> > -sub upload_file_to_server {
> > - my $param = shift;
> > - Sympa::Log::Syslog::do_log('debug',"Uploading file from field %s to
> > destination %s",$param->{'file_field'},$param->{'destination'});
> > - my $fh;
> > - unless ($fh = $param->{'query'}->upload($param->{'file_field'})) {
> > - Sympa::Log::Syslog::do_log('debug',"Cannot upload file from field
> > $param->{'file_field'}");
> > - return undef;
> > - }
> > -
> > - unless (open FILE, ">:bytes", $param->{'destination'}) {
> > - Sympa::Log::Syslog::do_log('debug',"Cannot open file
> > $param->{'destination'} : $!");
> > - return undef;
> > - }
> > - while (<$fh>) {
> > - print FILE;
> > - }
> > - close FILE;
> > - return 1;
> > -}
> > -
> > -1;
>
>
> --
> 株式会社コンバージョンセキュリティ&OSSソリューション部池田荘児
> 〒231-0004　神奈川県横浜市中区元浜町3-21-2 ヘリオス関内ビル7F
> e-mail address@concealed TEL 045-640-3550
> http://www.conversion.co.jp/
>

--
株式会社コンバージョンセキュリティ&OSSソリューション部池田荘児
〒231-0004　神奈川県横浜市中区元浜町3-21-2 ヘリオス関内ビル7F
e-mail address@concealed TEL 045-640-3550
http://www.conversion.co.jp/

Attachment: sympa-diffs.ods
Description: application/vnd.oasis.opendocument.spreadsheet

Re: [sympa-developpers] [sympa-commits] sympa[10085] trunk: [dev] move all perl modules in the same src/ lib directory, IKEDA Soji, 01/02/2014
- Re: [sympa-developpers] [sympa-commits] sympa[10085] trunk: [dev] move all perl modules in the same src/ lib directory, IKEDA Soji, 01/02/2014
- Re: [sympa-developpers] [sympa-commits] sympa[10085] trunk: [dev] move all perl modules in the same src/ lib directory, Guillaume Rousse, 01/02/2014
  - Re: [sympa-developpers] [sympa-commits] sympa[10085] trunk: [dev] move all perl modules in the same src/ lib directory, IKEDA Soji, 01/02/2014
    - Re: [sympa-developpers] [sympa-commits] sympa[10085] trunk: [dev] move all perl modules in the same src/ lib directory, Guillaume Rousse, 01/02/2014

List archive

Re: [sympa-developpers] [sympa-commits] sympa[10085] trunk: [dev] move all perl modules in the same src/ lib directory