[Nms-cgi-devel] Re: [Nms-cgi-commits] CVS Commit

[Jonathan S. <jn...@ge...>]

On Tue, 2004-08-24 at 10:23, Jonathan Stowe wrote:
> uid=68026(gellyfish) gid=100(users) groups=100(users),40625(nms-cgi),7054(xmlxslt)
> tfmail README,1.29,1.30 TFmail.pl,1.26,1.27
> Tue Aug 24 02:23:03 PDT 2004
> Update of /cvsroot/nms-cgi/tfmail
> In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26216
> 
> Modified Files:
> 	README TFmail.pl 
> Log Message:
> Added session capability to tie GET produced form to the POST

RCS file: /cvsroot/nms-cgi/tfmail/TFmail.pl,v
retrieving revision 1.26
retrieving revision 1.27
diff -r1.26 -r1.27
4c4
< # $Id: TFmail.pl,v 1.26 2004/08/20 08:00:16 gellyfish Exp $
---
> # $Id: TFmail.pl,v 1.27 2004/08/24 09:23:02 gellyfish Exp $
15a16
> use constant SESSION_DIR    => '.';
72c73
<    $VERSION = substr q$Revision: 1.26 $, 10, -1;
---
>    $VERSION = substr q$Revision: 1.27 $, 10, -1;
116a118,119
>       check_session($treq) or die "Bad or missing session
information";
>
167a171,283
> =item check_session ( TREQ )
>
> If L<use_session> would return a true value this will determine the
appropiate> method of determining the session id (either cookie or form
field) and
> retrieve the session id then check for its existence, returning true
if the
> session exists and false if it doesn't.  The session will be removed
if it
> exists.  It will always return true if sessions are not in use.
>
> =cut
>
> sub check_session
> {
>    my ( $treq ) = @_;
>
>    my $session_ok = 1;
>    if ( use_session($treq) )
>    {
>       $session_ok = 0;
>
>       my $session_id;
>       if ( $treq->config('session_cookie',0) )
>       {
>          $session_id = $treq->cgi()->cookie('SessionID');
>       }
>       else
>       {
>          $session_id =
$treq->param($treq->config('session_field','session'));>       }
>
>       if ( $session_id )
>       {
>          $session_id =~ /([a-fA-F0-9]+)/ or die "Bad Session id";
>          $session_id = $1;
>
>          my $session_file = "@{[ SESSION_DIR ]}/$session_id";
>
>          if ( -f $session_file )
>          {
>             $session_ok = 1;
>             unlink $session_file or die "Can't delete session
[$session_file]";
>          }
>       }
>
>    }
>
>    return $session_ok;
> }
>
> =item create_session ( TREQ )
>
> This creates the new session file in SESSION_DIR and returns the
number of
> the session created.  It will die if it is unable to create the
session file.
>
> =cut
>
> sub create_session
> {
>    my ( $treq ) = @_;
>
>    my $session_id = session_id();
>    my $session_file = "@{[ SESSION_DIR ]}/$session_id";
>
>    open TFILE, ">$session_file" or die "Unable to create session: $!";
>    print TFILE $ENV{REMOTE_ADDR};
>    close TFILE;
>
>    return $session_id;
> }
>
>
> =item session_id
>
> This returns a hexadecimal number that is suitable to be used as a
session ID
>
> =cut
>
> =for developers
>
> Please review the uniqueness of this - I tested with ~ 1.5m calls to
this
> code and didn't find any duplicates but different OS, levels of
concurrency
> and other factors may impact this.
>
> =cut
>
> sub session_id
> {
>    return sprintf("%x%x%x", (time() +  $$) * rand, {} * rand,[] *rand)
> }
>
> =item use_session ( TREQ )
>
> This returns a true value if either the configuration items
'session_cookie'
> or session_field are set, indicating that for a GET request the
appropriate
> session should be generated and for a POST the existence of the
session
> should be checked before any further actions are taken.
>
> =cut
>
> sub use_session
> {
>    my ( $treq ) = @_;
>
>    if ( $treq->config('session_cookie','') ||
$treq->config('session_field',''))
>    {
>       return 1;
>    }
>    else
>    {
>       return 0;
>    }
>
> }
>
210a327,328
>       my @cookie = ();
>
212c330,351
<       html_page($treq, $treq->config('get_template'));
---
>
>       if (use_session($treq) )
>       {
>          my $session_id = create_session($treq);
>
>          my $me = $treq->cgi()->script_name();
>
>          if ( $treq->config('session_cookie',0) )
>          {
>             my $cookie = $treq->cgi()->cookie('-name'  => 'SessionID',
>                                               '-value' => $session_id,
>                                               '-path'  => $me );
>             @cookie = ('-cookie' => $cookie);
>          }
>          else
>          {
>             $treq->install_directive('session_id', $session_id);
>          }
>
>       }
>
>       html_page($treq, $treq->config('get_template'),@cookie);
352a492,493
>       @fields = grep {!($treq->config('session_field',0)
>                    and ($_ eq $treq->config('session_field',''))) }
@fields;
997c1138
< =item html_page ( TREQ, TEMPLATE )
---
> =item html_page ( TREQ, TEMPLATE, EXTRA )
999c1140,1141
< Outputs an HTML page using the template TEMPLATE.
---
> Outputs an HTML page using the template TEMPLATE.  EXTRA is an array
that is
> passed directlyn to L<html_header>.
1005c1147
<    my ($treq, $template) = @_;
---
>    my ($treq, $template, @extra) = @_;
1007c1149
<    html_header();
---
>    html_header(@extra);
1063c1205
< =item html_header ()
---
> =item html_header (EXTRA)
1065c1207,1209
< Outputs the CGI header using a content-type of text/html.
---
> Outputs the CGI header using a content-type of text/html. The optional
> argument EXTRA comprise an array of key/value pairs that will be
passed
> directly to header() method of the CGI module.
1069a1214
>     my @extra = @_;
1072c1217
<         print header('-type'=>'text/html', '-charset'=>CHARSET);
---
>         print header('-type'=>'text/html', '-charset'=>CHARSET,
@extra);
1077c1222
<         print header('-type' => "text/html; charset=@{[ CHARSET ]}");
---
>         print header('-type' => "text/html; charset=@{[ CHARSET ]}",
@extra);

This adds the ability (in association with the GET handling facility
added earler) to create a session  that means that the POSTed request is
as the result of the submission of a form that was generated by a GET
request.  The ability to use either cookies or a hidden field to convey
the session id is included.

Can people check this (and the README ) out - I intend to make a release
of this (and the previously added and not released stuff) in the next
couple of days.

/J\