This file is indexed.

/usr/share/perl5/Apache/SessionX.pm is in libapache-sessionx-perl 2.01-4.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
###################################################################################
#
#   Apache::SessionX - Copyright (c) 1999-2001 Gerald Richter / ecos gmbh
#   Copyright(c) 1998, 1999 Jeffrey William Baker (jeffrey@kathyandjeffrey.net)
#
#   You may distribute under the terms of either the GNU General Public
#   License or the Artistic License, as specified in the Perl README file.
#
#   THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
#   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
#   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
#   $Id: SessionX.pm,v 1.4 2001/12/04 13:33:39 richter Exp $
#
###################################################################################


package Apache::SessionX ;

use strict;
use vars qw(@ISA $VERSION);

$VERSION = '2.01';
@ISA = qw(Apache::Session);

use Apache::Session;
use Apache::SessionX::Config ;

use constant NEW      => Apache::Session::NEW () ;
use constant MODIFIED => Apache::Session::MODIFIED () ;
use constant DELETED  => Apache::Session::DELETED () ;
use constant SYNCED   => Apache::Session::SYNCED () ;


sub TIEHASH {
    my $class = shift;
    
    my $session_id = shift;
    my $args       = shift || {};

    if(ref $args ne "HASH") 
        {
        die "Additional arguments should be in the form of a hash reference";
        }

    my $config = $args -> {config} || $Apache::SessionX::Config::default;
    foreach my $cfg (keys  (%{$Apache::SessionX::Config::param{$config}})) 
        {
        $args -> {$cfg} = $Apache::SessionX::Config::param{$config} -> {$cfg} if (!exists $args -> {$cfg}) ;
        }  
    
    my $self = 
        {
        args         => $args,
        data         => { _session_id => $session_id },
        initial_session_id => $session_id,
        lock         => 0,
        lock_manager => undef,
        object_store => undef,
        status       => 0,
        serialized   => undef,
        idfrom       => $args -> {idfrom},
        newid        => $args -> {newid},
        };
    
    bless $self, $class;

    $self -> require_modules ($args) ;

    $self -> init if (!$args -> {'lazy'}) ;


    return $self ;
    }


sub require_modules
    {
    my $self = shift ;
    my $args = shift ;

    # check object_store and lock_manager classes (Apache::Session 1.00)
    
    foreach my $mod ('Store', 'Lock', 'Generate', 'Serialize')
        {
        if ($args -> {$mod})
            {
            if (!($args -> {$mod} =~ /::/)) 
                {
                my $modname = "Apache::SessionX::$mod\:\:$args->{$mod}" ;
                eval "require $modname" ;
                if ($@) 
                    {
                    $@ = '' ;
                    $modname = "Apache::Session::$mod\:\:$args->{$mod}" ;
                    eval "require $modname" ;
                    }

                die "Cannot require $modname ($@)" if ($@) ;
                $args->{$mod} = $modname ;
                }
            else
                {
                my $modname = $args->{$mod} ;
                eval "require $modname" ;
                die "Cannot require $modname" if ($@) ;
                }
            }
        }
    }





sub init
    {
    my $self = shift ;

    #If a session ID was passed in, this is an old hash.
    #If not, it is a fresh one.

    $self->populate;

    my $session_id = $self->{data}->{_session_id} ;

    if (!$session_id && $self -> {idfrom})
        {
        $session_id = $self->{data}->{_session_id} = &{$self->{generate}}($self, $self -> {idfrom})  ;
        }

    $self->{initial_session_id} ||= $session_id ;


    if (defined $session_id  && $session_id) 
        {
        #check the session ID for remote exploitation attempts
        #this will die() on suspicious session IDs.        

        #eval { &{$self->{validate}}($self); } ;
        &{$self->{validate}}($self); 
        #if (!$@)
            { # session id is ok        

            $self->{status} &= ($self->{status} ^ NEW);

	    if ($self -> {'args'}{'create_unknown'})
	        {
                eval { $self -> restore } ;
	        #warn "Try to load session: $@" if ($@) ;
	        $@ = "" ;
	        $session_id = $self->{data}->{_session_id} ;
	        }
	    else
	        {
	        $self->restore;
	        }
            }
        }

    $@ = '' ;

    if (!($self->{status} & SYNCED))
        {
        $self->{status} |= NEW();
        if (!$self->{data}->{_session_id} || $self -> {'args'}{'recreate_id'})
            {
            if (exists ($self->{generate}))
                { # Apache::Session >= 1.50
	        $self->{data}->{_session_id} = &{$self->{generate}}($self)  ;
                }
            else
                {
	        $self->{data}->{_session_id} = $self -> generate_id() ;
                }
            }
        $self->save;
        }
    else
        {
        $self -> {newidpending} = $self -> {newid} ;
        }

    
    #warn "Session INIT $self->{initial_session_id};$self->{data}->{_session_id};" ;

    return $self;
    }





sub FETCH {
    my $self = shift;
    my $key  = shift;

    $self -> init if (!$self -> {'status'}) ;

    return $self->{data}->{$key};
}

sub STORE {
    my $self  = shift;
    my $key   = shift;
    my $value = shift;
    
    $self -> init if (!$self -> {'status'}) ;

    $self->{data}->{$key} = $value;
    
    $self->{status} |= MODIFIED;
    
    return $self->{data}->{$key};
}

sub DELETE {
    my $self = shift;
    my $key  = shift;
    
    $self -> init if (!$self -> {'status'}) ;

    $self->{status} |= MODIFIED;
    
    delete $self->{data}->{$key};
}

sub CLEAR {
    my $self = shift;

    $self -> init if (!$self -> {'status'}) ;

    $self->{status} |= MODIFIED;
    
    $self->{data} = {};
}

sub EXISTS {
    my $self = shift;
    my $key  = shift;
    
    $self -> init if (!$self -> {'status'}) ;

    return exists $self->{data}->{$key};
}

sub FIRSTKEY {
    my $self = shift;
    
    $self -> init if (!$self -> {'status'}) ;

    my $reset = keys %{$self->{data}};
    return each %{$self->{data}};
}

sub NEXTKEY {
    my $self = shift;
    
    $self -> init if (!$self -> {'status'}) ;

    return each %{$self->{data}};
}

sub DESTROY {
    my $self = shift;
    
    $self->save if ($self -> {'status'}) ;
    # destroy store object to make sure all data is written and everything 
    # is closed before we release the locks
    $self->{object_store} = undef ;
    $self->release_all_locks;
}

sub cleanup 
    {
    my $self = shift;
    
    $self->{initial_session_id} = undef ;
    if ($self -> {'status'})
	{
        $self->save;
        }
#    {
#    local $SIG{__WARN__} = 'IGNORE' ;
#    local $SIG{__DIE__}  = 'IGNORE' ; 
#    eval { $self -> {object_store} -> close } ; # Try to close file storage 
#    $@ = "" ;
#    }

    # destroy store object to make sure all data is written and everything 
    # is closed before we release the locks
    $self->{object_store} = undef ;
    $self->release_all_locks;

    $self->{'status'} = 0 ;
    $self->{data} = {} ;
    $self->{serialized} = undef ;
    # destroy lock object to make sure all locks are really released
    $self->{lock_manager} = undef ;
    }


sub setid {
    my $self = shift;

    $self->{'status'} = 0 ;
    $self->{data}->{_session_id} = $self->{initial_session_id} = shift ;
}

sub setidfrom {
    my $self = shift;

    $self->{'status'} = 0 ;
    $self->{data}->{_session_id} = $self->{initial_session_id} = undef ;
    $self->{idfrom} = shift ;

}
sub getid {
    my $self = shift;

    return $self->{data}->{_session_id}  ;
}

sub getids {
    my $self = shift;
    my $init = shift;

    $self -> init if ($init && !$self -> {'status'}) ;

    if ($self -> {newidpending} && $self->{status}) 
        {
        $self->{data}->{_session_id} = &{$self->{generate}}($self) ;
        $self -> {newidpending} = 0 ;
        $self->{status} |= NEW ;
        }

    return ($self->{initial_session_id}, $self->{data}->{_session_id},  $self->{status} & MODIFIED) ;
}

sub delete {
    my $self = shift;
    
    return if ($self->{status} & NEW);
    
    $self->{initial_session_id} = "!DELETE" ;

    $self -> init if (!$self -> {'status'}) ;

    $self->{status} |= DELETED;
    $self->save;
    $self->{data} = {} ; # Throw away the data
}    



sub restore {
    my $self = shift;
    
    return if ($self->{status} & SYNCED);
    return if ($self->{status} & NEW);
    
    if (exists $self -> {'args'}->{Transaction} && $self -> {'args'}->{Transaction}) 
        {
        $self->acquire_write_lock;
        }
    else
        {
        $self->acquire_read_lock;
        }

    $self->{object_store}->materialize($self);
    &{$self->{unserialize}}($self);
    
    $self->{status} &= ($self->{status} ^ MODIFIED);
    $self->{status} |= SYNCED
}


sub save {
    my $self = shift;
    
    return unless (
        $self->{status} & MODIFIED || 
        $self->{status} & NEW      || 
        $self->{status} & DELETED
    );
    
    if ($self -> {newidpending}) 
        {
        $self->{data}->{_session_id} = &{$self->{generate}}($self) ;
        $self -> {newidpending} = 0 ;
        $self->{status} |= NEW ;
        }

    $self->acquire_write_lock;

    if ($self->{status} & DELETED) {
        $self->{object_store}->remove($self);
        $self->{status} |= SYNCED;
        $self->{status} &= ($self->{status} ^ MODIFIED);
        $self->{status} &= ($self->{status} ^ DELETED);
        return;
    }
    if ($self->{status} & NEW) {
        &{$self->{serialize}}($self);
        $self->{object_store}->insert($self);
        $self->{status} &= ($self->{status} ^ NEW);
        $self->{status} |= SYNCED;
        $self->{status} &= ($self->{status} ^ MODIFIED);
        return;
    }

    if ($self->{status} & MODIFIED) {
        &{$self->{serialize}}($self);
        $self->{object_store}->update($self);
        $self->{status} &= ($self->{status} ^ MODIFIED);
        $self->{status} |= SYNCED;
        return;
    }
}


#

# For Apache::Session 1.00
#

sub get_object_store {
    my $self = shift;

    return new {$self -> {'args'}{'object_store'}} $self;
}

sub get_lock_manager {
    my $self = shift;
    
    return new {$self -> {'args'}{'lock_manager'}} $self;
}

#
# Default validate for Apache::Session < 1.53
#

sub validate {
    #This routine checks to ensure that the session ID is in the form
    #we expect.  This must be called before we start diddling around
    #in the database or the disk.

    my $session = shift;
    
    if ($session->{data}->{_session_id} !~ /^[a-fA-F0-9]+$/) {
        die 'Invalid session id' ;
    }
}

#
# For Apache::Session >= 1.50
#

sub populate 
    {
    my $self = shift;

    my $store = $self->{args}->{Store};
    my $lock  = $self->{args}->{Lock};
    if (!$self->{populated})
        {
        my $gen   = $self->{args}->{Generate};
        my $ser   = $self->{args}->{Serialize};


        $self->{object_store} = new $store $self if ($store) ;
        $self->{lock_manager} = new $lock $self if ($lock);
        $self->{generate}     = \&{$gen . '::generate'} if ($gen);
        $self->{'validate'}     = \&{$gen . '::validate'} if ($gen && defined (&{$gen . '::validate'}));
        $self->{serialize}    = \&{$ser . '::serialize'} if ($ser);
        $self->{unserialize}  = \&{$ser . '::unserialize'} if ($ser) ;

        if (!defined ($self->{'validate'}))
            {
            $self->{'validate'} = \&validate ;
            }
        $self->{populated} = 1 ;
        }
    else
        { # recreate only store & lock classes as far as necessary
        $self->{object_store} ||= new $store $self if ($store) ;
        $self->{lock_manager} ||= new $lock $self if ($lock);
        }

    return $self;
    }



1 ;


__END__

=head1 NAME

Apache::SessionX  - An extented persistence framework for session data

=head1 SYNOPSIS

=head1 DESCRIPTION

Apache::SessionX extents Apache::Session. 
It was initially written to use Apache::Session from inside of HTML::Embperl, 
but is seems to be useful outside of Embperl as well, so here is it as standalone module.

Apache::Session is a persistence framework which is particularly useful
for tracking session data between httpd requests.  Apache::Session is
designed to work with Apache and mod_perl, but it should work under
CGI and other web servers, and it also works outside of a web server
altogether.

Apache::Session consists of five components: the interface, the object store,
the lock manager, the ID generator, and the serializer.  The interface is
defined in SessionX.pm, which is meant to be easily subclassed.  The object
store can be the filesystem, a Berkeley DB, a MySQL DB, an Oracle DB, or a
Postgres DB. Locking is done by lock files, semaphores, or the locking
capabilities of MySQL and Postgres.  Serialization is done via Storable, and
optionally  ASCII-fied via MIME or pack().  ID numbers are generated via MD5. 
The reader is encouraged to extend these capabilities to meet his own
requirements.

=head1 INTERFACE

The interface to Apache::SessionX is very simple: tie a hash to the
desired class and use the hash as normal.  The constructor takes two
optional arguments.  The first argument is the desired session ID
number, or undef for a new session.  The second argument is a hash
of options that will be passed to the object store and locker classes.


=head2 Addtional Attributes for TIE

=over 4

=item lazy

By specifying this attribute, you tell Apache::Session to not do any
access to the object store, until the first read or write access to
the tied hash. Otherwise the B<tie> function will make sure the hash
exist or creates a new one.

=item create_unknown

Setting this to one causes Apache::Session to create a new session
with the given id (or a new id, depending on C<recreate_id>)
when the specified session id does not exists. Otherwise it will die.

=item recreate_id

Setting this to one causes Apache::Session to create a new session id
when the specified session id does not exists. 

=item idfrom

instead of passing in a session id, you can pass in a string, from which
Apache::SessionX generates the id in case it needs one. The main advantage
from generating the id by yourself is, that in 'lazy' mode the
id is only generated when the session is accessed.

=item newid

Setting this to one will cause Apache::SessionX to generate a new id every
time the session is saved. If you call C<getid> or C<getids> it will return
the new id that will be used to save the data.

=item config

Use predefiend config from Apache::SessionX::Config, which is configured
at package installation time.  On Debian, these may be altered by running
C<dpkg-reconfigure libapache-sessionx-perl>.


=item object_store

Specify the class for the object store. (The Apache::Session:: prefix is
optional) Only for Apache::Session 1.00.

=item lock_manager

Specify the class for the lock manager. (The Apache::Session:: prefix is
optional) Only for Apache::Session 1.00.

=item Store

Specify the class for the object store. (The Apache::Session::Store prefix is
optional) Only for Apache::Session 1.5x.

=item Lock

Specify the class for the lock manager. (The Apache::Session::Lock prefix is
optional) Only for Apache::Session 1.5x.

=item Generate

Specify the class for the id generator. (The Apache::Session::Generate prefix is
optional) Only for Apache::Session 1.5x.

=item Serialize

Specify the class for the data serializer. (The Apache::Session::Serialize prefix is
optional) Only for Apache::Session 1.5x.


=back

Example using attrubtes to specfiy store and object classes instead of
a derived class:

 use Apache::SessionX

 tie %session, 'Apache::SessionX', undef,
    { 
    object_store => 'DBIStore',
    lock_manager => 'SysVSemaphoreLocker',
    DataSource => 'dbi:Oracle:db' 
    };

NOTE: Apache::SessionX will C<require> the nessecary additional perl modules for you.


=head2 Addtional Methods

=over 4

=item setid ($id)

Set the session id for futher accesses.

=item setidfrom ($string)

Set the string that is passed to the generate function to compute the id.

=item getid

Get the session id. The difference to using $session{_session_id} is,
that in lazy mode, getid will B<not> create a new session id, if it
doesn't exists.

=item getids ($init)

return the an array where the first element is the initial id, the second element
is the current id and the third element is set to true, when the session data was
modified. If the session was deleted, the initial id (first array value) will be set
to '!DELETE'.

If the optional parameter $init is set to true, getids will initialize the session 
(i.e. read from the store) when not already done.

=item cleanup

Writes any pending data, releases all locks and deletes all data from memory.

=back

=head1 SEE ALSO

=over 4

=item See documentation of Apache::Session for more information about it's internals

=item Apache::SessionX::Generate::MD5

=item Apache::Session::Store::*

=item Apache::Session::Lock::*

=item Apache::Session::Serialize::*

=back


=head1 AUTHORS

Gerald Richter <richter@dev.ecos.de> is the current maintainer.

This class was written by Jeffrey Baker (jeffrey@kathyandjeffrey.net)
but it is taken wholesale from a patch that Gerald Richter
(richter@ecos.de) sent me against Apache::Session.