bbbike/BBBikeApacheSessionCounted.pm at master · eserte/bbbike · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
# -*- perl -*-

#
# Author: Slaven Rezic
#
# Copyright (C) 2011,2014,2017,2023,2026 Slaven Rezic. All rights reserved.
# This package is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# WWW:  https://github.com/eserte/bbbike
#

package BBBikeApacheSessionCounted;

use strict;
use vars qw($VERSION $debug);

$VERSION = '0.10';
$debug = $main::debug; # XXX hmmmm
$main::debug = $main::debug if 0; # cease -w

use POSIX qw(strftime);
use Apache::Session::Counted;

######################################################################
# CONFIGURATION SECTION
our %CLUSTER_DEFS = (
		     #'biokovo.herceg.de'                         => [1, 'http://biokovo/bbbike/cgi/asch'],
		     #'lvps83-169-19-137.dedicated.hosteurope.de' => [2, 'http://bbbike.lvps83-169-19-137.dedicated.hosteurope.de/cgi-bin/asch'],
		     'eserte'                                    => [3, 'http://eserte.bbbike.org/cgi-bin/asch'],
		     'mosor'                                     => [4, 'http://mosor/bbbike/cgi/asch'],
		     #'lvps176-28-19-132.dedicated.hosteurope.de' => [5, 'http://bbbike.lvps176-28-19-132.dedicated.hosteurope.de/cgi-bin/asch'],
		     #'bbbike-vmz'                                => [6, 'http://ip78-137-103-246.pbiaas.com/cgi-bin/asch'],
		     #'lvps83-169-5-248.dedicated.hosteurope.de'  => [7, 'http://bbbike.lvps83-169-5-248.dedicated.hosteurope.de/cgi-bin/asch'],
		     '177.227.205.92.host.secureserver.net'      => [8, 'http://177.227.205.92.host.secureserver.net/cgi-bin/asch'],
		     'bbbike-pps-bookworm'                       => [9, 'http://bbbike-pps-bookworm/cgi-bin/asch'],
		    );
######################################################################
our $THIS_HOST_ID;

sub pre_init {
    Apache::Session::CountedStore->tree_init("/tmp/bbbike-sessions-$<","1");
}

sub tie_session {
    my $id = shift;

    # To retrieve a session file:
    #perl -MData::Dumper -MStorable=thaw -e '$content=do{open my $fh,$ARGV[0] or die;local$/;<$fh>}; warn Dumper thaw $content' file

    #my $dirlevels = 0;
    my $dirlevels = 1;
    my @l = localtime;
    my $date;
    if (0) {
	# daily counter
	$date = sprintf "%04d-%02d-%02d", $l[5]+1900, $l[4]+1, $l[3];
    } else {
	# weekly counter
	$date = strftime("%G-W%V", @l); # iso 8601 year-week
    }
    ## Make sure a different user for cgi-bin/mod_perl operation is used
    #my $directory = "/tmp/bbbike-sessions-" . $< . "-$date";
    ## No need for per-day/week directories,
    ## I have /tmp/coordssessions
    my $directory = "/tmp/bbbike-sessions-" . $<;
    ## Resetting the sessions daily/weekly:
    my $counterfile = "/tmp/bbbike-counter-" . $< . "-$date";
    #my $counterfile = "/tmp/bbbike-counter-" . $<;

#     require File::Spec;
#     open(OLDOUT, ">&STDOUT") or die $!;
#     open(STDOUT, ">&STDERR") or die $!;
#     Apache::Session::CountedStore->tree_init($directory, $dirlevels);
#     close STDOUT;
#     open(STDOUT, ">&OLDOUT") or die $!;

    my %sess;
    eval {
	if (!defined $THIS_HOST_ID) {
	    require Sys::Hostname;
	    my $hostname = Sys::Hostname::hostname();
	    if (exists $CLUSTER_DEFS{$hostname}) {
		$THIS_HOST_ID = $CLUSTER_DEFS{$hostname}->[0];
	    } else {
		$THIS_HOST_ID = 0; # defined, but false
	    }
	}
	tie %sess, 'Apache::Session::Counted', $id,
	    { Directory => $directory,
	      DirLevels => $dirlevels,
	      CounterFile => $counterfile,
	      AlwaysSave => 1,
	      ($THIS_HOST_ID ?
	       (
		HostID  => $THIS_HOST_ID,
		HostURL => sub {
		    my($host_id, $session_id) = @_;
		    for (values %CLUSTER_DEFS) {
			if ($_->[0] eq $host_id) {
			    return $_->[1] . '?' . $session_id;
			}
		    }
		    warn "Cannot handle host id <$host_id>";
		    undef;
		},
	       ) : ()
	      ),
	      Timeout => 10,
	    } or do {
		warn $! if $debug;
		return undef;
	    };
    };
    if ($@) { # I think this normally does not happen
	if (!defined $id) {
	    # this is fatal
	    die "Cannot create new session: $@";
	} else {
	    # may happen for old sessions, e.g. in links, so
	    # do not die
	    warn "Cannot load old session, maybe already garbage-collected: $@";
	}
    }
    if (defined $id && keys %sess == 1) {
	# we silently assume that the session is invalid
	return undef;
    }

    return \%sess;
}

1;

__END__