+2.32
+ 2010-02-25
+ * (Validate) Allow for default to be an arrayref
+
+2.31
+ 2010-02-24
+ * (Auth) allow for secure flag via cookie_secure
+ * Allow validate.js to use change and blur on individual elements
+ * Allow validate.js to not strip trailing whitespace on change
+ * (Validate) Allow more items in local parts
+ * (Ex) Make sure make_form doesn't die on non-arrayref keys
+
2.27
2008-09-15
* (App) Fix morph history during errors or other direct morph calls
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: CGI-Ex
-version: 2.27
-version_from: lib/CGI/Ex.pm
-installdirs: site
-requires:
+--- #YAML:1.0
+name: CGI-Ex
+version: 2.32
+abstract: CGI utility suite - makes powerful application writing fun and easy
+license: ~
+author:
+ - Paul Seamons
+generated_by: ExtUtils::MakeMaker version 6.42
+distribution_type: module
+requires:
Template::Alloy: 1.004
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30_01
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
use base qw(Exporter);
BEGIN {
- $VERSION = '2.27';
+ $VERSION = '2.32';
$PREFERRED_CGI_MODULE ||= 'CGI';
@EXPORT = ();
@EXPORT_OK = qw(get_form
my $val = $form->{$key};
$key =~ s/([^\w.\-\ ])/sprintf('%%%02X', ord $1)/eg;
$key =~ y/ /+/;
- foreach (ref($val) ? @$val : $val) {
+ foreach (ref($val) eq 'ARRAY' ? @$val : $val) {
my $_val = $_; # make a copy
$_val =~ s/([^\w.\-\ ])/sprintf('%%%02X', ord $1)/eg;
$_val =~ y/ /+/;
eval { use Time::HiRes qw(time) };
eval { use Scalar::Util };
}
-our $VERSION = '2.27';
+our $VERSION = '2.32';
sub new {
my $class = shift || croak "Usage: ".__PACKAGE__."->new";
sub hash_base {
my ($self, $step) = @_;
- return $self->{'hash_base'} ||= do {
- my $copy = $self; eval { require Scalar::Util; Scalar::Util::weaken($copy) };
- my $hash = {
- script_name => $self->script_name,
- path_info => $self->path_info,
- js_validation => sub { $copy->run_hook('js_validation', $step, shift) },
- generate_form => sub { $copy->run_hook('generate_form', $step, (ref($_[0]) ? (undef, shift) : shift)) },
- form_name => $self->run_hook('form_name', $step),
- $self->step_key => $step,
- };
+ my $hash = $self->{'hash_base'} ||= {
+ script_name => $self->script_name,
+ path_info => $self->path_info,
};
+
+ my $copy = $self; eval { require Scalar::Util; Scalar::Util::weaken($copy) };
+ $hash->{'js_validation'} = sub { $copy->run_hook('js_validation', $step, shift) };
+ $hash->{'generate_form'} = sub { $copy->run_hook('generate_form', $step, (ref($_[0]) ? (undef, shift) : shift)) };
+ $hash->{'form_name'} = $self->run_hook('form_name', $step);
+ $hash->{$self->step_key} = $step;
+
+ return $hash;
}
sub hash_common { $_[0]->{'hash_common'} ||= {} }
use CGI::Ex;
use Carp qw(croak);
-$VERSION = '2.27';
+$VERSION = '2.32';
###----------------------------------------------------------------###
my $key = $args->{'name'};
my $val = $args->{'value'};
my $dom = $args->{'domain'} || $self->cookie_domain;
+ my $sec = $args->{'secure'} || $self->cookie_secure;
$self->cgix->set_cookie({
-name => $key,
-value => $val,
-path => $args->{'path'} || $self->cookie_path($key, $val) || '/',
($dom ? (-domain => $dom) : ()),
+ ($sec ? (-secure => $sec) : ()),
($args->{'expires'} ? (-expires => $args->{'expires'}): ()),
});
$self->cookies->{$key} = $val;
sub failed_sleep { shift->{'failed_sleep'} ||= 0 }
sub cookie_path { shift->{'cookie_path'} }
sub cookie_domain { shift->{'cookie_domain'} }
+sub cookie_secure { shift->{'cookie_secure'} }
sub use_session_cookie { shift->{'use_session_cookie'} }
sub disable_simple_cram { shift->{'disable_simple_cram'} }
+sub complex_plaintext { shift->{'complex_plaintext'} }
sub logout_redirect {
my ($self, $user) = @_;
: ($armor eq 'base64') ? eval { local $^W; decode_base64($token) }
: ($bkey = $self->use_blowfish) ? decrypt_blowfish($token, $bkey)
: next;
- if ($copy =~ m|^ ([^/]+) / (\d+) / (-?\d+) / (.*) / ([a-fA-F0-9]{32}) (?: / (sh\.\d+\.\d+))? $|x) {
+ if ($self->complex_plaintext && $copy =~ m|^ ([^/]+) / (\d+) / (-?\d+) / ([^/]*) / (.*) $|x) {
+ $data->add_data({
+ user => $1,
+ plain_time => $2,
+ expires_min => $3,
+ payload => $4,
+ test_pass => $5,
+ armor => $armor,
+ });
+ $found = 1;
+ last;
+ } elsif ($copy =~ m|^ ([^/]+) / (\d+) / (-?\d+) / ([^/]*) / ([a-fA-F0-9]{32}) (?: / (sh\.\d+\.\d+))? $|x) {
$data->add_data({
user => $1,
cram_time => $2,
} else {
my $rand1 = $1;
my $rand2 = $2;
- my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex($pass);
+ my $real = $pass =~ /^[a-fA-F0-9]{32}$/ ? lc($pass) : md5_hex($pass);
my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
my $sum = md5_hex($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
if ($data->{'expires_min'} > 0
} elsif ($data->{'cram_time'}) {
$data->add_data(type => 'simple_cram');
die "Type simple_cram disabled during verify_password" if $self->disable_simple_cram;
- my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex($pass);
+ my $real = $pass =~ /^[a-fA-F0-9]{32}$/ ? lc($pass) : md5_hex($pass);
my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
my $sum = md5_hex($str .'/'. $real);
if ($data->{'expires_min'} > 0
$err = 'Invalid login';
}
+ ### expiring plain
+ } elsif ($data->{'plain_time'}
+ && $data->{'expires_min'} > 0
+ && ($self->server_time - $data->{'plain_time'}) > $data->{'expires_min'} * 60) {
+ $err = 'Login expired';
+
### plaintext_crypt
} elsif ($pass =~ m|^([./0-9A-Za-z]{2})([./0-9A-Za-z]{11})$|
&& crypt($data->{'test_pass'}, $1) eq $pass) {
### failed plaintext crypt
} elsif ($self->use_crypt) {
$err = 'Invalid login';
- $data->add_data(type => 'crypt', was_plaintext => ($data->{'test_pass'} =~ /^[a-f0-9]{32}$/ ? 0 : 1));
+ $data->add_data(type => 'crypt', was_plaintext => ($data->{'test_pass'} =~ /^[a-fA-F0-9]{32}$/ ? 0 : 1));
### plaintext and md5
} else {
- my $is_md5_t = $data->{'test_pass'} =~ /^[a-f0-9]{32}$/;
- my $is_md5_r = $pass =~ /^[a-f0-9]{32}$/;
+ my $is_md5_t = $data->{'test_pass'} =~ /^[a-fA-F0-9]{32}$/;
+ my $is_md5_r = $pass =~ /^[a-fA-F0-9]{32}$/;
my $test = $is_md5_t ? lc($data->{'test_pass'}) : md5_hex($data->{'test_pass'});
my $real = $is_md5_r ? lc($pass) : md5_hex($pass);
$data->add_data(type => ($is_md5_r ? 'md5' : 'plaintext'), was_plaintext => ($is_md5_t ? 0 : 1));
die "Can't generate a token off of a failed auth" if ! $data;
die "Can't generate a token for a user which contains a \"/\"" if $data->{'user'} =~ m{/};
my $token;
+ my $exp = defined($data->{'expires_min'}) ? $data->{'expires_min'} : $self->expires_min;
+
+ my $user = $data->{'user'} || die "Missing user";
+ my $load = $self->generate_payload($data);
+ die "User can not contain a \"/\." if $user =~ m|/|;
+ die "Payload can not contain a \"/\. Please encode it in generate_payload." if $load =~ m|/|;
### do kinds that require staying plaintext
if ( (defined($data->{'use_plaintext'}) ? $data->{'use_plaintext'} : $self->use_plaintext) # ->use_plaintext is true if ->use_crypt is
|| (defined($data->{'use_crypt'}) && $data->{'use_crypt'})
|| (defined($data->{'type'}) && $data->{'type'} eq 'crypt')) {
my $pass = defined($data->{'test_pass'}) ? $data->{'test_pass'} : $data->{'real_pass'};
- $token = $data->{'user'} .'/'. $pass;
+ $token = $self->complex_plaintext ? join('/', $user, $self->server_time, $exp, $load, $pass) : "$user/$pass";
### all other types go to cram - secure_hash_cram, simple_cram, plaintext and md5
} else {
- my $user = $data->{'user'} || die "Missing user";
- my $real = defined($data->{'real_pass'}) ? ($data->{'real_pass'} =~ /^[a-f0-9]{32}$/ ? lc($data->{'real_pass'}) : md5_hex($data->{'real_pass'}))
- : die "Missing real_pass";
- my $exp = defined($data->{'expires_min'}) ? $data->{'expires_min'} : $self->expires_min;
- my $load = $self->generate_payload($data);
- die "Payload can not contain a \"/\. Please escape it in generate_payload." if $load =~ m|/|;
- die "User can not contain a \"/\." if $user =~ m|/|;
-
+ my $real = defined($data->{'real_pass'}) ? ($data->{'real_pass'} =~ /^[a-fA-F0-9]{32}$/ ? lc($data->{'real_pass'}) : md5_hex($data->{'real_pass'}))
+ : die "Missing real_pass";
my $array;
if (! $data->{'prefer_simple_cram'}
&& ($array = eval { $self->secure_hash_keys })
cgix
cleanup_user
cookie_domain
+ cookie_secure
cookie_path
cookies
expires_min
);
@EXPORT_OK = qw(conf_read conf_write in_cache);
-$VERSION = '2.27';
+$VERSION = '2.32';
$DEFAULT_EXT = 'conf';
use CGI::Ex::Dump qw(debug ctrace dex_html);
BEGIN {
- $VERSION = '2.27';
+ $VERSION = '2.32';
$SHOW_TRACE = 0 if ! defined $SHOW_TRACE;
$IGNORE_EVAL = 0 if ! defined $IGNORE_EVAL;
$EXTENDED_ERRORS = 1 if ! defined $EXTENDED_ERRORS;
use strict;
use Exporter;
-$VERSION = '2.27';
+$VERSION = '2.32';
@ISA = qw(Exporter);
@EXPORT = qw(dex dex_warn dex_text dex_html ctrace dex_trace);
@EXPORT_OK = qw(dex dex_warn dex_text dex_html ctrace dex_trace debug);
use base qw(Exporter);
BEGIN {
- $VERSION = '2.27';
+ $VERSION = '2.32';
@EXPORT = qw(form_fill);
@EXPORT_OK = qw(fill form_fill html_escape get_tagval_by_key swap_tagval_by_key);
};
use base qw(Exporter);
BEGIN {
- $VERSION = '2.27';
+ $VERSION = '2.32';
@EXPORT = qw(JSONDump);
@EXPORT_OK = @EXPORT;
$VOBJS
);
-$VERSION = '2.27';
+$VERSION = '2.32';
### install true symbol table aliases that can be localized
*QR_PRIVATE = *Template::Alloy::QR_PRIVATE;
use strict;
use Carp qw(croak);
-our $VERSION = '2.27';
+our $VERSION = '2.32';
our $QR_EXTRA = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/;
our @UNSUPPORTED_BROWSERS = (qr/MSIE\s+5.0\d/i);
our $JS_URI_PATH;
if ($field_val->{'had_error'} && ! $self->{'had_error'}->{$field}) { return [[$field, 'had_error', $field_val, $ifs_match]]; }
if ($field_val->{'was_checked'} && ! $self->{'was_checked'}->{$field}) { return [[$field, 'was_checked', $field_val, $ifs_match]]; }
- my $values = UNIVERSAL::isa($form->{$field},'ARRAY') ? $form->{$field} : [$form->{$field}];
- my $n_values = @$values;
-
# allow for default value
- if (exists $field_val->{'default'}) {
- if ($n_values == 0 || ($n_values == 1 && (! defined($values->[0]) || ! length($values->[0])))) {
- $form->{$field} = $values->[0] = $field_val->{'default'};
- }
+ if (defined($field_val->{'default'})
+ && (!defined($form->{$field})
+ || (UNIVERSAL::isa($form->{$field},'ARRAY') ? !@{ $form->{$field} } : !length($form->{$field})))) {
+ $form->{$field} = $field_val->{'default'};
}
+ my $values = UNIVERSAL::isa($form->{$field},'ARRAY') ? $form->{$field} : [$form->{$field}];
+ my $n_values = @$values;
+
# allow for a few form modifiers
my $modified = 0;
foreach my $value (@$values) {
# the "username" portion of an email address - sort of arbitrary
} elsif ($type eq 'local_part') {
return 0 if ! defined($value) || ! length($value);
- return 0 if $value =~ m/[^A-Za-z0-9_.\-\^=?\#!&+]/
- || $value =~ m/^[\.\-]/
- || $value =~ m/[\.\-\&]$/
- || $value =~ m/(\.\-|\-\.|\.\.)/;
+ # ignoring all valid quoted string local parts
+ return 0 if $value =~ m/[^\w.~!\#\$%\^&*\-=+?]/;
# standard IP address
} elsif ($type eq 'ip') {
{
field => 'my_ip',
match => 'm/^\d{1,3}(\.\d{1,3})3$/',
- match_2 => '!/^0\./ || !/^192\./',
+ match_2 => '!m/^0\./ || !m/^192\./',
}
=item C<max_in_set> and C<min_in_set>
-// Copyright 2008 - Paul Seamons - $Revision: 1.81 $
+// Copyright 2008 - Paul Seamons - $Revision: 1.18 $
// Distributed under the Perl Artistic License without warranty
// See perldoc CGI::Ex::Validate for usage
for (var i = 0; i < values.length; i++) {
if (typeof(values[i]) == 'undefined') continue;
var orig = values[i];
- if (! field_val.do_not_trim) values[i] = values[i].replace(/^\s+/,'').replace(/\s+$/,'');
+ if (! field_val.do_not_trim) {
+ values[i] = values[i].replace(/^\s+/,'');
+ if (v_event != 'change') values[i] = values[i].replace(/\s+$/,'');
+ }
if (field_val.trim_control_chars) values[i] = values[i].replace(/\t/g,' ').replace(/[\x00-\x1F]/g,'');
if (field_val.to_upper_case) values[i] = values[i].toUpperCase();
if (field_val.to_lower_case) values[i] = values[i].toLowerCase();
} else if (type == 'LOCAL_PART') {
if (typeof(value) == 'undefined' || ! value.length) return 0;
if (typeof(v_local_part) != 'undefined') return (value.match(v_local_part) ? 1 : 0);
- if (value.match(/[^a-z0-9.\-!&+]/)) return 0;
- if (value.match(/^[.\-]/)) return 0;
- if (value.match(/[.\-&]$/)) return 0;
- if (value.match(/(\.-|-\.|\.\.)/)) return 0;
+ // ignoring all valid quoted string local parts
+ if (value.match(/[^\w.~!\#\$%\^&*\-=+?]/)) return 0;
} else if (type == 'IP') {
if (! value) return 0;
}
var f = val_hash['group set_all_hook'] || document.validate_set_all_hook;
- if (f) f(err_obj);
+ if (f) f(err_obj, val_hash, form);
var field = err_obj.first_field();
if (field && form[field]) {
if (k == 'extend') continue; // Protoype Array()
var el = form[k];
if (! el) return v_error("No form element by the name "+k);
- v_el_attach(el, h[k], form, val_hash);
+ var _change = !types.change ? 0 : typeof(types.change) == 'object' ? types.change[k] : 1;
+ var _blur = !types.blur ? 0 : typeof(types.blur) == 'object' ? types.blur[k] : 1;
+ v_el_attach(el, h[k], form, val_hash, _change, _blur);
}
}
if (types.load) { v_event = 'load'; document.validate(form) }
}
-function v_el_attach (el, fvs, form, val_hash) {
+function v_el_attach (el, fvs, form, val_hash, _change, _blur) {
+ if (!_change && !_blur) return;
if (! el.type) {
- if (el.length) for (var i = 0; i < el.length; i++) v_el_attach(el[i], fvs, form, val_hash);
+ if (el.length) for (var i = 0; i < el.length; i++) v_el_attach(el[i], fvs, form, val_hash, _change, _blur);
return;
}
var types = val_hash['group onevent'];
v_inline_error_set(k, e[k], val_hash, form);
}
};
- if (types.blur) el.onblur = func;
- if (types.change && ! (''+el).match(/HTMLCollection/)) { // find better way on opera
+ if (_blur) el.onblur = func;
+ if (_change && ! (''+el).match(/HTMLCollection/)) { // find better way on opera
var type = el.type ? el.type.toLowerCase() : '';
if (type.match(/(password|text|textarea)/)) el.onkeyup = func;
else if (type.match(/(checkbox|radio)/)) el.onclick = func;
###----------------------------------------------------------------###
-sub load_conf { 1 } # let configuration be read from a file
+sub load_conf { 1 }
sub conf_file { "$Bin/app1.yaml" }
sub conf_validation { {path => {required => 1, max_values => 100}} }
-sub allow_morph { 1 } # allow each step to be in a separate file
+sub allow_morph { 1 }
sub name_module { "" } # allow content files to be in /tt/ directory directly
sub template_path { "$Bin/tt" }
=head1 NAME
-App1::DoBill - This step would process the billing
+App1::DoBill - handle this step of the App1 app
=cut
=head1 NAME
-App1::PickDomain - usually the first step - pick a domain
+App1::PickDomain - handle this step of the App1 app
=cut
=head1 NAME
-App1::Thankyou - show the final page of the application
+App1::Thankyou - handle this step of the App1 app
=cut
=head1 NAME
-1_validate_03_cgi.t - Test CGI::Ex::Validate's ability to interact with CGI.pm.
+1_validate_03_cgi.t - Test CGI::Ex::Fill's ability to interact with CGI.pm.
=cut
my $strings_html = join("\n", sort split(/[\s><]+/, lc($html)));
ok($strings_output eq $strings_html,
- "Strings matched");
+ "Strings matched ($strings_output)");
projects / chaz / p5-CGI-Ex / commitdiff
