Skip to content

Commit

Permalink
update extlib to CGI.pm-3.43 and libwww-perl-5.829 from CPAN - remain…
Browse files Browse the repository at this point in the history 
…ing files after finding out previous git commit only included new files

Signed-off-by: Jay Allen <jay@endevver.com>
  • Loading branch information
@jayallen
Ian Kluft authored and jayallen committed Aug 3, 2009
1 parent bc92b01 commit 280de67
Show file tree
Hide file tree
Showing 51 changed files with 10,867 additions and 5,206 deletions.
3,061 changes: 2,128 additions & 933 deletions extlib/CGI.pm
View file

Large diffs are not rendered by default.

329 changes: 259 additions & 70 deletions extlib/CGI/Carp.pm
View file

Large diffs are not rendered by default.

184 changes: 142 additions & 42 deletions extlib/CGI/Cookie.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,56 +13,82 @@ package CGI::Cookie;
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.

$CGI::Cookie::VERSION='1.20';
$CGI::Cookie::VERSION='1.29';

use CGI::Util qw(rearrange unescape escape);
use CGI;
use overload '""' => \&as_string,
'cmp' => \&compare,
'fallback'=>1;

# Turn on special checking for Doug MacEachern's modperl
my $MOD_PERL = 0;
if (exists $ENV{MOD_PERL}) {
if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
$MOD_PERL = 2;
require Apache2::RequestUtil;
require APR::Table;
} else {
$MOD_PERL = 1;
require Apache;
}
}

# fetch a list of cookies from the environment and
# return as a hash. the cookies are parsed as normal
# escaped URL data.
sub fetch {
my $class = shift;
my $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
return () unless $raw_cookie;
my $raw_cookie = get_raw_cookie(@_) or return;
return $class->parse($raw_cookie);
}

# fetch a list of cookies from the environment and
# return as a hash. the cookie values are not unescaped
# or altered in any way.
sub raw_fetch {
my $class = shift;
my $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
return () unless $raw_cookie;
my %results;
my($key,$value);

my(@pairs) = split("; ?",$raw_cookie);
foreach (@pairs) {
s/\s*(.*?)\s*/$1/;
if (/^([^=]+)=(.*)/) {
$key = $1;
$value = $2;
}
else {
$key = $_;
$value = '';
}
$results{$key} = $value;
# Fetch a list of cookies from the environment or the incoming headers and
# return as a hash. The cookie values are not unescaped or altered in any way.
sub raw_fetch {
my $class = shift;
my $raw_cookie = get_raw_cookie(@_) or return;
my %results;
my($key,$value);

my @pairs = split("[;,] ?",$raw_cookie);
foreach (@pairs) {
s/\s*(.*?)\s*/$1/;
if (/^([^=]+)=(.*)/) {
$key = $1;
$value = $2;
}
else {
$key = $_;
$value = '';
}
$results{$key} = $value;
}
return \%results unless wantarray;
return %results;
}

sub get_raw_cookie {
my $r = shift;
$r ||= eval { $MOD_PERL == 2 ?
Apache2::RequestUtil->request() :
Apache->request } if $MOD_PERL;
if ($r) {
$raw_cookie = $r->headers_in->{'Cookie'};
} else {
if ($MOD_PERL && !exists $ENV{REQUEST_METHOD}) {
die "Run $r->subprocess_env; before calling fetch()";
}
return \%results unless wantarray;
return %results;
$raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
}
}


sub parse {
my ($self,$raw_cookie) = @_;
my %results;

my(@pairs) = split("; ?",$raw_cookie);
my @pairs = split("[;,] ?",$raw_cookie);
foreach (@pairs) {
s/\s*(.*?)\s*/$1/;
my($key,$value) = split("=",$_,2);
Expand All @@ -87,8 +113,11 @@ sub parse {
sub new {
my $class = shift;
$class = ref($class) if ref($class);
my($name,$value,$path,$domain,$secure,$expires) =
rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_);
# Ignore mod_perl request object--compatability with Apache::Cookie.
shift if ref $_[0]
&& eval { $_[0]->isa('Apache::Request::Req') || $_[0]->isa('Apache') };
my($name,$value,$path,$domain,$secure,$expires,$httponly) =
rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES,HTTPONLY],@_);

# Pull out our parameters.
my @values;
Expand Down Expand Up @@ -117,22 +146,26 @@ sub new {
$self->domain($domain) if defined $domain;
$self->secure($secure) if defined $secure;
$self->expires($expires) if defined $expires;
$self->httponly($httponly) if defined $httponly;
# $self->max_age($expires) if defined $expires;
return $self;
}

sub as_string {
my $self = shift;
return "" unless $self->name;

my(@constant_values,$domain,$path,$expires,$secure);
my(@constant_values,$domain,$path,$expires,$max_age,$secure,$httponly);

push(@constant_values,"domain=$domain") if $domain = $self->domain;
push(@constant_values,"path=$path") if $path = $self->path;
push(@constant_values,"domain=$domain") if $domain = $self->domain;
push(@constant_values,"path=$path") if $path = $self->path;
push(@constant_values,"expires=$expires") if $expires = $self->expires;
push(@constant_values,"max-age=$max_age") if $max_age = $self->max_age;
push(@constant_values,"secure") if $secure = $self->secure;
push(@constant_values,"HttpOnly") if $httponly = $self->httponly;

my($key) = escape($self->name);
my($cookie) = join("=",$key,join("&",map escape($_),$self->value));
my($cookie) = join("=",(defined $key ? $key : ''),join("&",map escape(defined $_ ? $_ : ''),$self->value));
return join("; ",$cookie,@constant_values);
}

Expand All @@ -142,6 +175,22 @@ sub compare {
return "$self" cmp $value;
}

sub bake {
my ($self, $r) = @_;

$r ||= eval {
$MOD_PERL == 2
? Apache2::RequestUtil->request()
: Apache->request
} if $MOD_PERL;
if ($r) {
$r->headers_out->add('Set-Cookie' => $self->as_string);
} else {
print CGI::header(-cookie => $self);
}

}

# accessors
sub name {
my $self = shift;
Expand Down Expand Up @@ -172,7 +221,7 @@ sub value {
sub domain {
my $self = shift;
my $domain = shift;
$self->{'domain'} = $domain if defined $domain;
$self->{'domain'} = lc $domain if defined $domain;
return $self->{'domain'};
}

Expand All @@ -190,13 +239,28 @@ sub expires {
return $self->{'expires'};
}

sub max_age {
my $self = shift;
my $expires = shift;
$self->{'max-age'} = CGI::Util::expire_calc($expires)-time() if defined $expires;
return $self->{'max-age'};
}

sub path {
my $self = shift;
my $path = shift;
$self->{'path'} = $path if defined $path;
return $self->{'path'};
}


sub httponly { # HttpOnly
my $self = shift;
my $httponly = shift;
$self->{'httponly'} = $httponly if defined $httponly;
return $self->{'httponly'};
}

1;

=head1 NAME
Expand Down Expand Up @@ -283,11 +347,24 @@ that all scripts at your site will receive the cookie.
If the "secure" attribute is set, the cookie will only be sent to your
script if the CGI request is occurring on a secure channel, such as SSL.
=item B<4. httponly flag>
If the "httponly" attribute is set, the cookie will only be accessible
through HTTP Requests. This cookie will be inaccessible via JavaScript
(to prevent XSS attacks).
But, currently this feature only used and recognised by
MS Internet Explorer 6 Service Pack 1 and later.
See this URL for more information:
L<http://msdn.microsoft.com/workshop/author/dhtml/httponly_cookies.asp>
=back
=head2 Creating New Cookies
$c = new CGI::Cookie(-name => 'foo',
my $c = new CGI::Cookie(-name => 'foo',
-value => 'bar',
-expires => '+3M',
-domain => '.capricorn.com',
Expand Down Expand Up @@ -317,11 +394,31 @@ pages at your site.
B<-secure> if set to a true value instructs the browser to return the
cookie only when a cryptographic protocol is in use.
B<-httponly> if set to a true value, the cookie will not be accessible
via JavaScript.
For compatibility with Apache::Cookie, you may optionally pass in
a mod_perl request object as the first argument to C<new()>. It will
simply be ignored:
my $c = new CGI::Cookie($r,
-name => 'foo',
-value => ['bar','baz']);
=head2 Sending the Cookie to the Browser
Within a CGI script you can send a cookie to the browser by creating
one or more Set-Cookie: fields in the HTTP header. Here is a typical
sequence:
The simplest way to send a cookie to the browser is by calling the bake()
method:
$c->bake;
Under mod_perl, pass in an Apache request object:
$c->bake($r);
If you want to set the cookie yourself, Within a CGI script you can send
a cookie to the browser by creating one or more Set-Cookie: fields in the
HTTP header. Here is a typical sequence:
my $c = new CGI::Cookie(-name => 'foo',
-value => ['bar','baz'],
Expand All @@ -331,8 +428,6 @@ sequence:
print "Content-Type: text/html\n\n";
To send more than one cookie, create several Set-Cookie: fields.
Alternatively, you may concatenate the cookies together with "; " and
send them in one field.
If you are using CGI.pm, you send cookies by providing a -cookie
argument to the header() method:
Expand All @@ -342,7 +437,7 @@ argument to the header() method:
Mod_perl users can set cookies using the request object's header_out()
method:
$r->header_out('Set-Cookie',$c);
$r->headers_out->set('Set-Cookie' => $c);
Internally, Cookie overloads the "" operator to call its as_string()
method when incorporated into the HTTP header. as_string() turns the
Expand Down Expand Up @@ -378,6 +473,11 @@ form using the parse() class method:
$COOKIES = `cat /usr/tmp/Cookie_stash`;
%cookies = parse CGI::Cookie($COOKIES);
If you are in a mod_perl environment, you can save some overhead by
passing the request object to fetch() like this:
CGI::Cookie->fetch($r);
=head2 Manipulating Cookies
Cookie objects have a series of accessor methods to get and set cookie
Expand Down
41 changes: 12 additions & 29 deletions extlib/CGI/Fast.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,10 +13,7 @@ package CGI::Fast;
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.

# The most recent version and complete docs are available at:
# http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
# ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
$CGI::Fast::VERSION='1.04';
$CGI::Fast::VERSION='1.07';

use CGI;
use FCGI;
Expand Down Expand Up @@ -57,6 +54,8 @@ sub new {
return undef unless FCGI::accept() >= 0;
}
}
CGI->_reset_globals;
$self->_setup_symbols(@SAVED_SYMBOLS) if @CGI::SAVED_SYMBOLS;
return $CGI::Q = $self->SUPER::new($initializer, @param);
}

Expand All @@ -83,33 +82,17 @@ CGI::Fast - CGI Interface for Fast CGI
=head1 DESCRIPTION
CGI::Fast is a subclass of the CGI object created by
CGI.pm. It is specialized to work well with the Open Market
FastCGI standard, which greatly speeds up CGI scripts by
turning them into persistently running server processes. Scripts
that perform time-consuming initialization processes, such as
loading large modules or opening persistent database connections,
will see large performance improvements.
CGI::Fast is a subclass of the CGI object created by CGI.pm. It is
specialized to work well FCGI module, which greatly speeds up CGI
scripts by turning them into persistently running server processes.
Scripts that perform time-consuming initialization processes, such as
loading large modules or opening persistent database connections, will
see large performance improvements.
=head1 OTHER PIECES OF THE PUZZLE
In order to use CGI::Fast you'll need a FastCGI-enabled Web
server. Open Market's server is FastCGI-savvy. There are also
freely redistributable FastCGI modules for NCSA httpd 1.5 and Apache.
FastCGI-enabling modules for Microsoft Internet Information Server and
Netscape Communications Server have been announced.
In addition, you'll need a version of the Perl interpreter that has
been linked with the FastCGI I/O library. Precompiled binaries are
available for several platforms, including DEC Alpha, HP-UX and
SPARC/Solaris, or you can rebuild Perl from source with patches
provided in the FastCGI developer's kit. The FastCGI Perl interpreter
can be used in place of your normal Perl without ill consequences.
You can find FastCGI modules for Apache and NCSA httpd, precompiled
Perl interpreters, and the FastCGI developer's kit all at URL:
http://www.fastcgi.com/
In order to use CGI::Fast you'll need the FCGI module. See
http://www.cpan.org/ for details.
=head1 WRITING FASTCGI PERL SCRIPTS
Expand All @@ -122,7 +105,7 @@ waiting some more.
A typical FastCGI script will look like this:
#!/usr/local/bin/perl # must be a FastCGI version of perl!
#!/usr/bin/perl
use CGI::Fast;
&do_some_initialization();
while ($q = new CGI::Fast) {
Expand Down
Loading

0 comments on commit 280de67

Please sign in to comment.