plweb-commits Mailing List for Perl Web Services
Status: Inactive
Brought to you by:
condordes
Menu
▾
▴
plweb-commits — CVS Mail
You can subscribe to this list here.
| 2001 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
(3) |
Nov
|
Dec
|
|---|
|
From: Josh <con...@us...> - 2001-10-27 09:08:38
|
Update of /cvsroot/plweb/Web/Web
In directory usw-pr-cvs1:/tmp/cvs-serv8727/Web
Modified Files:
Config.pm Session.pm
Added Files:
DBTable.pm
Removed Files:
SimpleDB.pm
Log Message:
Converted things over to use a real RDBMS. Got rid of the stupid GDB files
in /tmp. Added a configuration file plweb.conf. Changed everything so the
universe looks totally different. Had a mental awakening. Things like that.
--- NEW FILE: DBTable.pm ---
package Web::DBTable;
use DBI;
$db = DBI->connect("dbi:" . Config->get("db_provider"),
Config->get('db_user'), Config->get('db_passwd'));
sub get {
my $pkg = shift;
my $tbl = shift;
return bless { 'name' => $tbl }, $pkg;
}
sub first {
my ($tbl, $fields, $where) = @_;
my $qry = $db->prepare("select " . join(',', @$fields) . " from $tbl->{name} where $where");
my $rcd;
$qry->execute;
return $qry->fetchrow_hashref;
}
sub select {
my ($tbl, $fields, $where, $index_by) = @_;
my $qry = $db->prepare("select " . join(',', @$fields) . " from $tbl->{name} where $where");
my $ret = $index_by ? {} : [];
my $rcd;
$qry->execute;
while ($rcd = $qry->fetchrow_hashref) {
if ($index_by) {
$ret->{$rcd->{$index_by}} = $rcd;
} else {
push @$ret, $rcd;
}
}
return $index_by ? $ret : @$ret;
}
sub insert {
my $table = shift;
my %fields = @_;
my @keys = keys %fields; # It's done this way to be ABSOLUTELY safe
my @vals = ();
my $sql = "insert into $table->{name} (" . join(',', @keys) . ") values(";
foreach my $k (@keys) {
my $v = $fields{$k};
$v =~ s/\'/\\\'/g;
push @vals, "'" . $v . "'";
}
$sql .= join(',', @vals) . ")";
$db->do($sql);
}
sub update {
my $table = shift;
my $where = shift;
my %fields = @_;
my @vals = ();
my $sql = "update $table->{name} set ";
foreach my $key (keys %fields) {
my $v = $fields{$key};
$v =~ s/\'/\\\'/g;
push @vals, "$key='$v'";
}
$sql .= join ',', @vals;
$sql .= " where $where" if $where;
$db->do($sql);
}
sub delete {
my $table = shift;
my $where = shift;
my $w;
$w = "where $where" if $where;
$db->do("delete from $table->{name} $w");
}
1;
Index: Config.pm
===================================================================
RCS file: /cvsroot/plweb/Web/Web/Config.pm,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -r1.1.1.1 -r1.2
*** Config.pm 2001/05/02 15:28:57 1.1.1.1
--- Config.pm 2001/10/27 09:08:33 1.2
***************
*** 1,26 ****
package Config;
! my $cfgdb = Web::SimpleDB->new('/tmp/plweb-cfg.gdb');
! sub set {
! shift;
! return $cfgdb->set(@_);
}
sub get {
! shift;
! return $cfgdb->get(@_);
}
sub keys {
! shift;
! return $cfgdb->keys(@_);
}
- sub delete {
- shift;
- return $cfgdb->delete(@_);
- }
-
1;
--- 1,26 ----
package Config;
! my $cfgdb = {};
! my $line;
! open (WEBCFG, "< /etc/plweb.conf");
! while (! eof(WEBCFG)) {
! chomp ($line = <WEBCFG>);
! next if $line =~ /\#/;
! $line =~ /(\w+)\s+(.*)/;
! $cfgdb->{$1} = $2;
}
+ close (WEBCFG);
sub get {
! shift;
! return $cfgdb->{$_[0]};
}
sub keys {
! shift;
! return keys %$cfgdb;
}
1;
***************
*** 34,59 ****
use Web;
-
- # Store a single value under key 'foo'
- Config->set('foo', 'bar');
- $x = Config->get('foo');
! # Store multiple values under 'bar'
! Config->set('bar', 'foo', 'baz');
! @y = Config->get('bar');
! # Delete everything
foreach $k (Config->keys) {
! Config->delete($k);
}
=head1 DESCRIPTION
! This works the same way as Web::SimpleDB. Take a look at that for
! documentation.
=head1 SEE ALSO
! Web::SimpleDB
=head1 AUTHOR
--- 34,52 ----
use Web;
! $y = Config->get('bar');
! # Enumerate everything
foreach $k (Config->keys) {
! Config->get($k);
}
=head1 DESCRIPTION
! Stores site-specific configuration information.
=head1 SEE ALSO
! Web::DBTable
=head1 AUTHOR
Index: Session.pm
===================================================================
RCS file: /cvsroot/plweb/Web/Web/Session.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** Session.pm 2001/09/30 02:37:57 1.2
--- Session.pm 2001/10/27 09:08:33 1.3
***************
*** 1,122 ****
package Session;
! my $sessdb = Web::SimpleDB->new('/tmp/plweb-sess.gdb');
! my $sessvardb = Web::SimpleDB->new('/tmp/plweb-sessvars.gdb');
! my $uservardb = Web::SimpleDB->new('/tmp/plweb-uservars.gdb');
sub login {
! my $pkg = shift;
! my $user = shift;
! my $pwd = shift;
! my $proto;
! my $sessid = sprintf('%.8x', time) . sprintf('%.8x', rand() * 2**32);
!
! if ($proto = _usr_authenticate($user, $pwd)) {
!
! # Multiple logins aren't allowed
! foreach my $k ($sessdb->keys) {
! my @rcd = $sessdb->get($k);
! if ($rcd[0] eq $proto && $rcd[1] eq $user) {
! $sessid = $k;
! }
! }
!
! Browser->cookie('sessid', $sessid);
! $sessdb->set($sessid, $proto, $user);
! return bless { sessid=>$sessid, proto=>$proto, user=>$user }, $pkg;
}
! return undef;
}
sub get {
! my $pkg = shift;
! my $self;
! my $sid = Browser->cookie('sessid');
!
! return undef if ! $sid;
!
! my @rec = $sessdb->get($sid);
! if (! @rec) {
! Browser->cookie('sessid', '');
! return undef;
! }
!
! my $self = bless {
! sessid => $sid,
! proto => $rec[0],
! user => $rec[1]
! }, $pkg;
! return $self;
}
sub logout {
! my $self = shift;
! $sessdb->delete($self->{'sessid'});
! $sessvardb->delete($self->{'sessid'});
! Browser->cookie('sessid', '');
}
sub username {
! return $_[0]->{'user'};
}
sub proto {
! return $_[0]->{'proto'};
}
sub sess_var {
! my $self = shift;
! my $name = shift;
! my $val = shift;
!
! my %sessvars = $sessvardb->get($self->{'sessid'});
! if (defined $val) {
! $sessvars{$name} = $val;
! $sessvardb->set($self->{'sessid'}, %sessvars);
}
! return $sessvars{$name};
}
sub user_var {
! my $self = shift;
! my $name = shift;
! my $val = shift;
!
! my %uservars = $uservardb->get($self->{'proto'}.':'.$self->{'user'});
! if (defined $val) {
! $uservars{$name} = $val;
! $uservardb->set($self->{'proto'}.':'.$self->{'user'}, %uservars);
}
! return $uservars{$name};
}
sub _usr_authenticate {
! my $user = shift;
! my $pwd = shift;
!
! my $proto;
!
! my @authlist = Config->get(".auth.protolist");
!
! foreach $proto (@authlist) {
! eval "use $proto\;";
! die $@ if $@;
! }
!
! foreach $proto (@authlist) {
! return $proto if &{"$proto\::authenticate"}($user, $pwd);
! }
! return undef;
}
sub _usr_change_pwd {
! my $sess = shift;
! my $oldpw = shift;
! my $newpw = shift;
!
! eval "use $sess->{'proto'}\;";
!
! return &{$sess->{'proto'} . '::change_pwd'}($sess->{'user'},
! $oldpw, $newpw);
}
--- 1,134 ----
package Session;
! my $sessions = Web::DBTable->get('sys_sessions');
! my $sessvars = Web::DBTable->get('sys_sessvars');
! my $uservars = Web::DBTable->get('sys_uservars');
sub login {
! my $pkg = shift;
! my $user = shift;
! my $pwd = shift;
! my $proto;
! my $sessid = sprintf('%.8x', time) . sprintf('%.8x', rand() * 2**32);
!
! if ($proto = _usr_authenticate($user, $pwd)) {
!
! # Multiple logins aren't allowed
! my $oldsess;
! if ($oldsess = $sessions->first(['*'], "user='$user'")) {
! Browser->cookie('sessid', $oldsess->{'sessid'});
! } else {
! $sessions->insert('sessid' => $sessid,
! 'proto' => $proto, 'user' => $user);
}
! return bless { sessid=>$sessid, proto=>$proto, user=>$user }, $pkg;
! }
! return undef;
}
sub get {
! my $pkg = shift;
! my $self;
! my $sid = Browser->cookie('sessid');
!
! return undef if ! $sid;
!
! my $rec = $sessions->first(['*'], "sessid='$sid'");
! if (! $rec) {
! Browser->cookie('sessid', '');
! return undef;
! }
!
! my $self = bless {
! sessid => $rec->{'sessid'},
! proto => $rec->{'proto'},
! user => $rec->{'user'}
! }, $pkg;
! return $self;
}
sub logout {
! my $self = shift;
! $sessions->delete("sessid='$self->{'sessid'}'");
! $sessvars->delete("sessid='$self->{'sessid'}'");
! Browser->cookie('sessid', '');
}
sub username {
! return $_[0]->{'user'};
}
sub proto {
! return $_[0]->{'proto'};
}
sub sess_var {
! my $self = shift;
! my $name = shift;
! my $val = shift;
! my $where = "sessid='$self->{'sessid'}' and name='$name'";
!
! my $sv = $sessvars->first(['*'], $where);
! if (defined $val) {
! if ($sv) {
! $sessvars->update($where, 'value' => $val);
! } else {
! $sessvars->insert('sessid' => $self->{'sessid'},
! 'name' => $name, 'value' => $val);
}
! $sv->{'value'} = $val;
! }
!
! return $sv->{'value'};
}
sub user_var {
! my $self = shift;
! my $name = shift;
! my $val = shift;
! my $where = "user='$self->{'user'}' and name='$name'";
!
! my $sv = $uservars->first(['*'], $where);
! if (defined $val) {
! if ($sv) {
! $uservars->update($where, 'value' => $val);
! } else {
! $uservars->insert('user' => $self->{'user'},
! 'name' => $name, 'value' => $val);
}
! $sv->{'value'} = $val;
! }
!
! return $sv->{'value'};
}
sub _usr_authenticate {
! my $user = shift;
! my $pwd = shift;
!
! my $proto;
!
! my @authlist = split ',', Config->get("auth_mode");
!
! foreach $proto (@authlist) {
! eval "use $proto\;";
! die $@ if $@;
! }
!
! foreach $proto (@authlist) {
! return $proto if &{"$proto\::authenticate"}($user, $pwd);
! }
! return undef;
}
sub _usr_change_pwd {
! my $sess = shift;
! my $oldpw = shift;
! my $newpw = shift;
!
! eval "use $sess->{'proto'}\;";
!
! return &{$sess->{'proto'} . '::change_pwd'}($sess->{'user'},
! $oldpw, $newpw);
}
***************
*** 200,202 ****
Joshua J. Berry <con...@so...>
! =cut
\ No newline at end of file
--- 212,214 ----
Joshua J. Berry <con...@so...>
! =cut
--- SimpleDB.pm DELETED ---
|
|
From: Josh <con...@us...> - 2001-10-27 09:08:38
|
Update of /cvsroot/plweb/Web
In directory usw-pr-cvs1:/tmp/cvs-serv8727
Modified Files:
MANIFEST Makefile.PL Web.pm
Added Files:
plweb.conf
Removed Files:
plwebconf
Log Message:
Converted things over to use a real RDBMS. Got rid of the stupid GDB files
in /tmp. Added a configuration file plweb.conf. Changed everything so the
universe looks totally different. Had a mental awakening. Things like that.
--- NEW FILE: plweb.conf ---
auth_mode Web::Auth::DB_MD5
db_provider mysql:plweb
db_user plweb
db_passwd plweb or something smarter
Index: MANIFEST
===================================================================
RCS file: /cvsroot/plweb/Web/MANIFEST,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** MANIFEST 2001/08/31 21:17:19 1.2
--- MANIFEST 2001/10/27 09:08:32 1.3
***************
*** 4,8 ****
MANIFEST
INSTALL
! Web/Auth/GDBCrypt.pm
Web/Browser.pm
Web/Config.pm
--- 4,9 ----
MANIFEST
INSTALL
! Web/Auth/DB_MD5.pm
! Web/Auth/DBCrypt.pm
Web/Browser.pm
Web/Config.pm
***************
*** 10,15 ****
Web/Server.pm
Web/Session.pm
- Web/SimpleDB.pm
Web/Handler/EmbHTML.pm
Makefile.PL
Makefile.cvs
--- 11,16 ----
Web/Server.pm
Web/Session.pm
Web/Handler/EmbHTML.pm
+ Web/DBTable.pm
Makefile.PL
Makefile.cvs
***************
*** 18,27 ****
Web.kdevprj
Web.pm
! plwebconf
test.pl
WebObject/Handler.pm
- WebObject/Tree.pm
WebObject/Object.pm
! WebObject.pm
! Web.kdevses
! webobj-mounts.conf
--- 19,29 ----
Web.kdevprj
Web.pm
! WebObject.pm
test.pl
+ webobj-mounts.conf
WebObject/Handler.pm
WebObject/Object.pm
! WebObject/Tree.pm
! doc/webobj.docbook
! plweb.conf
! base_db.sql
Index: Makefile.PL
===================================================================
RCS file: /cvsroot/plweb/Web/Makefile.PL,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** Makefile.PL 2001/08/31 21:17:19 1.2
--- Makefile.PL 2001/10/27 09:08:32 1.3
***************
*** 12,15 ****
'PMLIBDIRS' => ['lib', 'Web', 'Web/Auth', 'Web/Handler',
'WebObject'],
! 'EXE_FILES' => [ 'plwebconf' ],
);
--- 12,15 ----
'PMLIBDIRS' => ['lib', 'Web', 'Web/Auth', 'Web/Handler',
'WebObject'],
! # 'EXE_FILES' => [ 'plwebconf' ],
);
Index: Web.pm
===================================================================
RCS file: /cvsroot/plweb/Web/Web.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** Web.pm 2001/09/30 02:37:57 1.3
--- Web.pm 2001/10/27 09:08:32 1.4
***************
*** 3,11 ****
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
$VERSION = '0.1.0';
- use Web::SimpleDB;
use Web::Config;
use Web::Server;
use Web::Browser;
--- 3,12 ----
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+ use Carp qw(confess);
$VERSION = '0.1.0';
use Web::Config;
+ use Web::DBTable;
use Web::Server;
use Web::Browser;
***************
*** 66,70 ****
Web::Browser, Web::Config, Web::Handler, Web::Server, Web::Session,
! Web::SimpleDB, WebObject::Handler
=cut
--- 67,71 ----
Web::Browser, Web::Config, Web::Handler, Web::Server, Web::Session,
! Web::DBTable, WebObject::Handler
=cut
--- plwebconf DELETED ---
|
|
From: Josh <con...@us...> - 2001-10-27 09:08:37
|
Update of /cvsroot/plweb/Web/Web/Auth
In directory usw-pr-cvs1:/tmp/cvs-serv8727/Web/Auth
Added Files:
DBCrypt.pm DB_MD5.pm
Removed Files:
GDBCrypt.pm
Log Message:
Converted things over to use a real RDBMS. Got rid of the stupid GDB files
in /tmp. Added a configuration file plweb.conf. Changed everything so the
universe looks totally different. Had a mental awakening. Things like that.
--- NEW FILE: DBCrypt.pm ---
package Web::Auth::DBCrypt;
$users = Web::DBTable->get('sys_users');
sub authenticate {
my ($user, $passwd) = @_;
my $usr = $users->first(["passwd"], "user='$user'");
return 0 if ! $usr;
my $upwd = $usr->{'passwd'};
my $cpwd = crypt $passwd, substr($upwd, 0, 2);
return ($cpwd eq $upwd);
}
sub adduser {
my ($user, $newpwd) = @_;
return 0 if $users->first(["user"], "user='$user'");
$users->insert('user' => $user, 'passwd' =>crypt($newpwd,
join('', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64])));
return 1;
}
sub deluser {
my ($user) = @_;
$users->delete("user='$user'");
return 1;
}
sub change_pwd {
my ($user, $oldpwd, $newpwd) = @_;
return 0 if ! authenticate($user, $oldpwd);
$users->update("user='$user'", 'passwd' => crypt($newpwd,
join('', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64])));
return 1;
}
1;
=head1 NAME
Web::Auth::DBCrypt - Uses the native DB and the crypt() function to store
usernames and passwords.
=head1 SYNOPSIS
You should use Web::Session to authenticate users. The only reason to directly
access Web::Auth::DBCrypt is to perform user management tasks.
B<PLEASE NOTE> that this module is B<NOT COMPATIBLE> with other DB
authentication modules which are provided (such as DB_MD5)
use Web::Auth::DBCrypt; # This must happen even if you use Web;
Web::Auth::DBCrypt::adduser("username", "passwd");
Web::Auth::DBCrypt::deluser("username");
Web::Auth::DBCrypt::change_pwd("username", "oldpasswd", "newpasswd");
=head1 DESCRIPTION
=over 4
=item Web::Auth::DBCrypt::B<adduser>(username, passwd)
Adds the specified user to the database and sets his/her password.
=item Web::Auth::DBCrypt::B<deluser>(username, passwd)
Removes the specified user from the database.
=item Web::Auth::DBCrypt::B<change_pwd>(username, oldpwd, newpwd)
Changes the user's password, provided that his/her old password is correct.
=back
=head1 AUTHORS
Joshua J. Berry <con...@us...>
=cut
--- NEW FILE: DB_MD5.pm ---
package Web::Auth::DB_MD5;
use Digest::MD5 qw(md5_base64);
$users = Web::DBTable->get('sys_users');
sub authenticate {
my ($user, $passwd) = @_;
my $usr = $users->first(["passwd"], "user='$user'");
return 0 if ! $usr;
my $upwd = $usr->{'passwd'};
my $cpwd = md5_base64($passwd);
return ($cpwd eq $upwd);
}
sub adduser {
my ($user, $newpwd) = @_;
return 0 if $users->first(["user"], "user='$user'");
$users->insert('user' => $user, 'passwd' => md5_base64($newpwd));
return 1;
}
sub deluser {
my ($user) = @_;
$users->delete("user='$user'");
return 1;
}
sub change_pwd {
my ($user, $oldpwd, $newpwd) = @_;
return 0 if ! authenticate($user, $oldpwd);
$users->update("user='$user'", 'passwd' => md5_base64($newpwd));
return 1;
}
1;
=head1 NAME
Web::Auth::DB_MD5 - Uses the native DB and the MD5 function to store
usernames and passwords.
=head1 SYNOPSIS
You should use Web::Session to authenticate users. The only reason to directly
access Web::Auth::DB_MD5 is to perform user management tasks.
B<PLEASE NOTE> that this module is B<NOT COMPATIBLE> with other DB
authentication modules which are provided (such as DBCrypt)
use Web::Auth::DB_MD5; # This must happen even if you use Web;
Web::Auth::DB_MD5::adduser("username", "passwd");
Web::Auth::DB_MD5::deluser("username");
Web::Auth::DB_MD5::change_pwd("username", "oldpasswd", "newpasswd");
=head1 DESCRIPTION
=over 4
=item Web::Auth::DB_MD5::B<adduser>(username, passwd)
Adds the specified user to the database and sets his/her password.
=item Web::Auth::DB_MD5::B<deluser>(username, passwd)
Removes the specified user from the database.
=item Web::Auth::DB_MD5::B<change_pwd>(username, oldpwd, newpwd)
Changes the user's password, provided that his/her old password is correct.
=back
=head1 AUTHORS
Joshua J. Berry <con...@us...>
=cut
--- GDBCrypt.pm DELETED ---
|
