[Jifty-commit] r3005 - in CASPlus/trunk: . bin doc etc lib lib/CASPlus lib/CASPlus/Action lib/CASPlus/Model share share/po share/web share/web/static share/web/templates share/web/templates/_elements share/web/templates/user t var

jifty-commit at lists.jifty.org jifty-commit at lists.jifty.org
Fri Mar 16 16:35:38 EDT 2007


Author: sterling
Date: Fri Mar 16 16:35:35 2007
New Revision: 3005

Added:
   CASPlus/trunk/AUTHORS
   CASPlus/trunk/Makefile.PL
   CASPlus/trunk/README
   CASPlus/trunk/bin/
   CASPlus/trunk/bin/jifty   (contents, props changed)
   CASPlus/trunk/doc/
   CASPlus/trunk/doc/example-user.html
   CASPlus/trunk/etc/
   CASPlus/trunk/etc/config.yml
   CASPlus/trunk/lib/
   CASPlus/trunk/lib/CASPlus/
   CASPlus/trunk/lib/CASPlus.pm
   CASPlus/trunk/lib/CASPlus/Action/
   CASPlus/trunk/lib/CASPlus/Action/Login.pm
   CASPlus/trunk/lib/CASPlus/Action/LoginCheck.pm
   CASPlus/trunk/lib/CASPlus/Action/Logout.pm
   CASPlus/trunk/lib/CASPlus/Action/Proxy.pm
   CASPlus/trunk/lib/CASPlus/Action/ProxyValidate.pm
   CASPlus/trunk/lib/CASPlus/Action/Validate.pm
   CASPlus/trunk/lib/CASPlus/CurrentUser.pm
   CASPlus/trunk/lib/CASPlus/Dispatcher.pm
   CASPlus/trunk/lib/CASPlus/Manual/
   CASPlus/trunk/lib/CASPlus/Manual/Config.pod
   CASPlus/trunk/lib/CASPlus/Model/
   CASPlus/trunk/lib/CASPlus/Model/LoginAttempt.pm
   CASPlus/trunk/lib/CASPlus/Model/Profile.pm
   CASPlus/trunk/lib/CASPlus/Model/ProfileProperty.pm
   CASPlus/trunk/lib/CASPlus/Model/ProxyGrantSession.pm
   CASPlus/trunk/lib/CASPlus/Model/ProxySession.pm
   CASPlus/trunk/lib/CASPlus/Model/Role.pm
   CASPlus/trunk/lib/CASPlus/Model/RoleMember.pm
   CASPlus/trunk/lib/CASPlus/Model/SSOSession.pm
   CASPlus/trunk/lib/CASPlus/Model/ServiceSession.pm
   CASPlus/trunk/lib/CASPlus/Model/User.pm
   CASPlus/trunk/lib/CASPlus/ProfileBase.pm
   CASPlus/trunk/lib/CASPlus/Util.pm
   CASPlus/trunk/share/
   CASPlus/trunk/share/po/
   CASPlus/trunk/share/web/
   CASPlus/trunk/share/web/static/
   CASPlus/trunk/share/web/templates/
   CASPlus/trunk/share/web/templates/_elements/
   CASPlus/trunk/share/web/templates/_elements/header
   CASPlus/trunk/share/web/templates/login
   CASPlus/trunk/share/web/templates/logout
   CASPlus/trunk/share/web/templates/proxy
   CASPlus/trunk/share/web/templates/proxyValidate
   CASPlus/trunk/share/web/templates/serviceValidate
   CASPlus/trunk/share/web/templates/status
   CASPlus/trunk/share/web/templates/user/
   CASPlus/trunk/share/web/templates/user/view
   CASPlus/trunk/share/web/templates/validate
   CASPlus/trunk/t/
   CASPlus/trunk/t/00-dependencies.t
   CASPlus/trunk/t/10-model-LoginAttempt.t
   CASPlus/trunk/t/10-model-Profile.t
   CASPlus/trunk/t/10-model-ProfileProperty.t
   CASPlus/trunk/t/10-model-ProxyGrantSession.t
   CASPlus/trunk/t/10-model-ProxySession.t
   CASPlus/trunk/t/10-model-Role.t
   CASPlus/trunk/t/10-model-RoleMember.t
   CASPlus/trunk/t/10-model-SSOSession.t
   CASPlus/trunk/t/10-model-ServiceSession.t
   CASPlus/trunk/t/10-model-User.t
   CASPlus/trunk/t/20-action-Login.t
   CASPlus/trunk/t/20-action-LoginCheck.t
   CASPlus/trunk/t/20-action-Logout.t
   CASPlus/trunk/t/20-action-Proxy.t
   CASPlus/trunk/t/20-action-ProxyValidate.pm
   CASPlus/trunk/t/20-action-Validate.t
   CASPlus/trunk/t/40-tickets.t
   CASPlus/trunk/t/50-me.t
   CASPlus/trunk/t/50-root-redirect.t
   CASPlus/trunk/t/99-CAS-protocol.t
   CASPlus/trunk/t/test-service.pl
   CASPlus/trunk/t/util.pl
   CASPlus/trunk/var/

Log:
Publishing the CAS+ project for the wide world to see.

Added: CASPlus/trunk/AUTHORS
==============================================================================
--- (empty file)
+++ CASPlus/trunk/AUTHORS	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,2 @@
+In order of first commit:
+Andrew Sterling Hanenkamp <andrew.hanenkamp at boomer.com>

Added: CASPlus/trunk/Makefile.PL
==============================================================================
--- (empty file)
+++ CASPlus/trunk/Makefile.PL	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,27 @@
+use inc::Module::Install;
+
+name        'CASPlus';
+license     'Perl';
+version     '0.01';
+
+requires    'Digest::MD5';
+requires    'Jifty' => '0.70129';
+requires    'Jifty::DBI';
+requires    'List::Util';
+requires    'LWP::UserAgent';
+requires    'Readonly';
+requires    'Scalar::Defer';
+requires    'String::Format';
+requires    'URI';
+
+features(
+    'Development and Testing' => [
+        -default => 0,
+        recommends('Test::XML::XPath'),
+        recommends('Test::Dependencies'),
+    ],
+);
+
+auto_install();
+
+WriteAll;

Added: CASPlus/trunk/README
==============================================================================
--- (empty file)
+++ CASPlus/trunk/README	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,40 @@
+CAS+ is an implementation of the Central Authentication Protocol.
+
+See the documentation in the CASPlus module for details.
+
+  perldoc lib/CASPlus.pm
+
+INSTALLATION
+
+In order to try this out, you must install the virtual-models branch of Jifty:
+
+  svn co http://svn.jifty.org/svn/jifty.org/jifty/branches/virtual-models
+  cd virtual-models
+  perl Makefile.PL
+  make
+  make test
+  make install
+
+once you have that installed, return to this directory and perform the usual:
+
+  perl Makefile.PL
+  make
+  make test
+  make install
+
+GETTING HELP
+
+You can try and get help from zostay (me) on the #jifty IRC channel on freenode
+or contact the Jifty developers mailing list.
+
+See http://jifty.org/ for more information on those resources. At this time,
+this project is being developed somewhat informally without it's own project
+resources until more folks are interested, my company decides to start hosting
+more information about it, or something else changes.
+
+COPYRIGHT AND LICENSE
+
+Copyright 2007 Boomer Consulting, Inc.
+
+This program is free software and may be modified and distributed under the
+same terms as Perl itself.

Added: CASPlus/trunk/bin/jifty
==============================================================================
--- (empty file)
+++ CASPlus/trunk/bin/jifty	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+use File::Basename qw(dirname); 
+use UNIVERSAL::require;
+
+BEGIN {
+    Jifty::Util->require or die $UNIVERSAL::require::ERROR;
+    my $root = Jifty::Util->app_root;
+    unshift @INC, "$root/lib" if ($root);
+}
+
+use Jifty::Script;
+local $SIG{INT} = sub { warn "Stopped\n"; exit; };
+Jifty::Script->dispatch();

Added: CASPlus/trunk/doc/example-user.html
==============================================================================
--- (empty file)
+++ CASPlus/trunk/doc/example-user.html	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,39 @@
+<html xmlns="http://www.w3.org/1999/xhtml">
+    <head>
+        <title>John Smith</title>
+
+        <rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+                 xmlns:bcmd="http://boomer.com/rdf/memberDirectory">
+            <foaf:Person rdf:about="http://boomer.com/members/directory/member/john_smith">
+                <foaf:name>John Smith</foaf:name>
+                <foaf:title>Mr.</foaf:name>
+                <foaf:homepage>http://www.john-llp.com/</foaf:homepage>
+                <foaf:mbox>john at john-llp.com</foaf:mbox>
+                <bcmd:jobTitle>CEO</bcmd:jobTitle>
+                <foaf:holdsAccount>
+                    <rdf:type rdf:resource="http://boomer.com/members/BoomerConsultingWebAccount"/>
+                    <foaf:accountServiceHomepage rdf:resource="http://www.boomer.com/members.html"/>
+                    <foaf:accountName>john at john-llp.com</foaf:accountName>
+                </foaf:holdsAccount>
+            </foaf:Person>
+                    
+                </foaf:Person>
+                <bcmd:member>
+                    <rdf:Description rdf:resource>
+                    </rdf:Description>
+                </bcmd:member>
+                <bcmd:member_of>
+                    <bcmd:firm rdf:resource="http://boomer.com/members/directory/firm/Smith-LLP"/>
+                    <bcmd:circle rdf:resource="http://boomer.com/members/directory/circle/BTC-US-1"/>
+                    <bcmd:performance3_class rdf:resource="http://boomer.com/members/directory/performance3/2007-1"/>
+                    <bcmd:role rdf:resource="http://boomer.com/members/directory/role/firm-delegate"/>
+                </bcmd:member_of>
+            </rdf:Description>
+        </rdf:RDF>
+    </head>
+    <body>
+        <h1>John Smith</h1>
+
+        <p>Information about John Smith formatted for humans...</p>
+    </body>
+</html>

Added: CASPlus/trunk/etc/config.yml
==============================================================================
--- (empty file)
+++ CASPlus/trunk/etc/config.yml	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,67 @@
+--- 
+framework: 
+  AdminMode: 1
+  ApplicationClass: CASPlus
+  ApplicationName: CASPlus
+  ApplicationUUID: EC7095D2-B700-11DB-9310-01BD470BAD47
+  Database: 
+    CheckSchema: 1
+    Database: casplus
+    Driver: SQLite
+    Host: localhost
+    Password: ''
+    RecordBaseClass: Jifty::DBI::Record::Cachable
+    User: ''
+    Version: 0.0.1
+  DevelMode: 1
+  L10N: 
+    PoDir: share/po
+  LogLevel: INFO
+  Mailer: Sendmail
+  MailerArgs: []
+
+  Plugins: []
+
+  PubSub: 
+    Backend: Memcached
+    Enable: ~
+  Web: 
+    BaseURL: http://localhost
+    DataDir: var/mason
+    Globals: []
+
+    MasonConfig: 
+      autoflush: 0
+      default_escape_flags: h
+      error_format: text
+      error_mode: fatal
+    Port: 8889
+    ServeStaticFiles: 1
+    StaticRoot: share/web/static
+    TemplateRoot: share/web/templates
+
+application:
+  Login:
+    RequireSecureLogin: 0
+    ShowLoginWarningCheckbox: 1
+    AllowLogout: 1
+#    PassServicesAnonymousNames: 1
+#  Membership:
+#    MemberDirectoryViewableBy: group:Member Directory
+  Proxy:
+    RequireSecureProxies: 0
+#  Signup:
+#    AllowAnonymousSignup: 1
+#    RequireEmailConfirmation: 1
+#    AllowMemberInvitationSignup: 1
+  Tickets:
+    Defaults:
+      Format: '%p-'
+      ExpirationTime:
+        minutes: 5
+      Length: 32
+    PGT:
+      Length: 64
+    TGC:
+      Length: 64
+      ExpirationTime: forever 

Added: CASPlus/trunk/lib/CASPlus.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,232 @@
+use strict;
+use warnings;
+
+package CASPlus;
+
+our $VERSION = '0.0.1';
+
+=head1 NAME
+
+CASPlus - An alternative Central Authentication Service server
+
+=head1 DESCRIPTION
+
+CAS is a single sign-on protocol for web applications developed at Yale and the reference implementation server is provided by JA-SIG. This is the only CAS server implementation that I am aware of.
+
+=head2 SINGLE SIGN-ON
+
+The best definition of single sign-on that I've seen was given at nosheep.net as:
+
+=over
+
+One userid, one password, entered one time, with passage allowed from one system to another without interruption
+
+=back
+
+L<http://nosheep.net/story/single-sign-on-definition/>
+
+By using CAS, a user can fill in their username and password exactly once and then never see the login form again (for the duration of that browser session) across any of the sites that trust that CAS server. Those sites will automatically pull credentials from the CAS server based upon a single cookie given to the user's browser.
+
+=head2 CENTRAL AUTHENTICATION SERVICE
+
+The CAS protocol is widely supported in a number of different languages and many web applications have built-in or add-on support for CAS authentication. The reason for this popularity is likely due to the following:
+
+=over
+
+=item 1.
+
+B<Standard.> The CAS authentication system follows a published protocol definition. The standard is maintained by JA-SIG, the Java Architectures Special Interest Group.
+
+=item 2.
+
+B<Simple.> The CAS protocol is extremely simple. From both the server and client perspective, the protocol is easily implemented. The server has fewer than a dozen actions and views to implement. The client generally only needs to implement a two step process of redirecting the client to the CAS server and then validating a service ticket. Proxying is more complicated, but for what is provided, it's still pretty simple.
+
+=item 3.
+
+B<Seamless.> The end-users never have to be aware of CAS. They are sent to a login screen just as they are already used to. The process of fetching a service ticket after they login the first time happens without the user being aware of it---unless they explicitly request to be made aware.
+
+=item 4.
+
+B<Flexible.> A client can provide a "login" link that asks the user to login. A client can wait until the user attempts to access a protected resource and then send the user to login or fetch a service ticket. A client could even poll for a user login with every click or every few clicks and then force login when they attempt to access a protected resource if they haven't already. A client can even present the user with the lgoin box again if after login they still don't have the required permissions.
+
+=item 5.
+
+B<Widely supported.> Many applications provide built-in or add-on support for CAS. There are CAS connectors for Apache, Java, C#, ColdFusion, Perl, PHP, Ruby, WebObjects, Zope, and others. The protocol is simple enough that adding a new client connector is not too difficult either.
+
+=back
+
+=head2 WHY CAS+?
+
+The existing implementation from JA-SIG works well, but there are a few issues that made me create this implementation:
+
+=over
+
+=item 1.
+
+B<Hosting.> I use a web host that doesn't provide access to a J2EE server or servlet container of any kind. You cannot run the JA-SIG implementation without a servlet container of some kind.
+
+This implementation is a Jifty application. It will run as CGI, FastCGI, a proxied server, or (coming soon) in mod_perl. The first two are supported by my web host.
+
+=item 2.
+
+B<Environment.> The original CAS assumes an environment that does not directly address my problem space. I'm building web applications for my web site. Security is relatively important, but I am not using SSL to make sure that the traffic is secure. 
+
+The JA-SIG CAS assumes a different situation of a university or enterprise environment where someone will access important private information: email, grades, etc. As such it provides airtight security requirements.
+
+This implementation can provide those airtight security requirements, but it is willing to break with the CAS protocol slightly to support a less strict and less secure environment.
+
+=item 3.
+
+B<Metadata.> There are generally three parts to client security issues: Is the user who he claims to be? Who is he? What is he permitted to do? CAS answers the first one well and the second one just barely. It doesn't handle the last item at all.
+
+CAS gives you a username on valid authentication, but generally a web application wants to know more. What is his email address? Where's his web site? What's his full name? What's his preferred nickname? None of this information is available through CAS. In a more traditional environment, one could set up LDAP to provide access to user information, but that's not an option in the environment I'm deploying to.
+
+CAS also does not handle authorization concerns in any way. If you want to know whether a given user needs full access, limited access, or highly restricted access, you need something other than CAS to tell you about it. Again, LDAP is a typical choice, but, again, I do not have this tool available to me.
+
+=back
+
+=head1 METHODS
+
+This is the main class and implements a few methods for handling startup tasks.
+
+=head2 start
+
+This is called by L<Jifty> immediately after startup to perform various initialization tasks.
+
+=cut
+
+sub start {
+    my $self = shift;
+
+    $self->setup_ticket_defaults;
+}
+
+=head2 setup_ticket_defaults
+
+This modifies the C<Tickets> configuration so that the defaults are applied to each ticket type. This is called by L</start>.
+
+=cut
+
+sub setup_ticket_defaults {
+    my $self = shift;
+
+    my %defaults = %{ Jifty->config->app('Tickets')->{'Defaults'} || {} };
+
+    $defaults{'ExpirationTime'} ||= { minutes => 5 };
+    $defaults{'Length'}         ||= 32;
+    $defaults{'Letters'}        ||= [ 
+        'A' .. 'Z', 'a' .. 'z', '0' .. '9', '-' 
+    ];
+
+    for my $ticket_type (qw/ ST PT PGT PGTIOU LT TGC /) {
+        my %custom   = %{ Jifty->config->app('Tickets')->{$ticket_type} || {} };
+
+        Jifty->config->app('Tickets')->{$ticket_type} 
+            = { ( %defaults, %custom ) };
+    }
+}
+
+=head1 IMPLEMENTED FEATURES
+
+This is a list of features that CAS+ supports. CAS+ provides the same functionality as the original CAS implementation with these additional features.
+
+=over
+
+=item *
+
+B<No SSL.> Normally you want all communication to be produced over SSL in a CAS environment. This isn't necessarily desirable for a web login, so you can turn off the SSL requirements, even on proxies. You are operating at a reduced security level and making it possible and even easy for a person in the right place to break in to your system. If such a break-in would provide the would-be attacker very little benefit or if you don't have access ot SSL even if you want it, this may acceptable.
+
+=item *
+
+B<Logout.> You can turn logout off to completely disallow it. You can set logins to last only for a certain amount of time rather than forever (as is the case under CAS as the login goes away once you lose your ticket granting cookie, i.e., you restart your browser). For example, you might set logins to last one month to allow them to "remember me" for that amount of time, but make them login every just to reconfirm.
+
+=back
+
+=head1 PLANNED FEATURES
+
+In the configuration file, you can turn each of the features listed here on or off. Each of these features can be turned on to provide additional power or modify the behavior of CAS+.
+
+=over
+
+=item *
+
+B<Personas.> One important feature of identity management is the ability to have different personas. Basically, personas would allow a user to pick what kind of persona they wish to present to a particular web service. On one the user might be using personal information from home while on another using work information.
+
+=item *
+
+B<Sudo.> CAS+ provides the ability for a privileged user to escalate their identity to a privileged user or even to login as an arbitrary person. This provides for web services functionality similar to Unix sudo. Obviously this has the potential for abuse, so it's use will be well-controlled and well-logged.
+
+=item *
+
+B<Truly Anonymous.> Services can be provided with an anonymous user ID rather than the username provided at login. This user ID is unique per service so the service does not even have your username unless that information is granted to the service. This way, logins are always completely anonymous unless that service has permission to query additional information about the authenticated user. 
+
+=item *
+
+B<Directory.> CAS+ provides a member directory. This can be used by the adminstrators to manage users. It can also be configured to allow members of your CAS+ to see each other's information. If you don't want people to see each other's info, then turn it off and it's not available to anyone but the user managers.
+
+=item *
+
+B<Profile.> Each user has a profile in which they can update personal information, change their password, request removal of their account, etc.
+
+=item *
+
+B<Metadata.> You can configure the metadata stored within user profiles and can determine how it is accessed.
+
+=item *
+
+B<Whitelists.> An ACL may be used to provide service whitelisitng and blacklisting to allow or deny services to access CAS, metadata, and other information. This can be used in combination with service accounts or not.
+
+=item *
+
+B<Service accounts.> In addition to user accounts in the system, CAS+ also provides service accounts. Services may authenticated against these accounts to verify their identity before being able to fetch metadata information. This way, you can configure what data is available to each service.
+
+=item *
+
+B<Sign-up.> CAS+ provides the ability for users to sign up for an account. The workflow for this process follows the typical steps of signing up, sending a verification email, verifying the email address, and providing login. Administrators may also be required for approval of the accounts.
+
+=item *
+
+B<Invitations.> CAS+ provides the ability for users to send invitations. These invitations are basically the same as sign-up except that the invitation may pre-approve the member to join certain private groups or get them into the web site without requiring administrator approval.
+
+=item *
+
+B<Tracking.> CAS+ provides tracking of information. You, the administrator, can see reports on attempted signups, attempted logins, invitations, etc. 
+
+=item *
+
+B<Roles/Permissions.> CAS+ provides security roles for assigning capabilities to users. These roles may be related to one another allowing for complex assignments derived from a single role membership. These roles may be passed on to services and can be used by those services to configure permissions or permissions can be assigned to roles within CAS+ and passed on as well.
+
+=item *
+
+B<Single Sign-Out.> CAS+ will proactively inform services of logout. Services who request this information will be informed this way. Services may also periodically request confirmation that a user is still logged.
+
+=item *
+
+B<Notification.> CAS+ can perform other notifications other than single sign-out. Notifications can be sent when a user's roles or permissions are updated, when a user's metadata is updated, etc.
+
+=back
+
+=head1 WISHLIST
+
+These are additional features that would be nice but are not actually planned at this time.
+
+=over
+
+=item *
+
+B<OpenID.> OpenID is a distributed login system. An application offering an OpenID login is willing to trust an unknown third party to provide authentication information. It would be nice if CAS+ provided both an OpenID authority and could accept logins from external OpenID sources, allowing a local account to be created/linked to an external OpenID account.
+
+=back
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/Action/Login.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Action/Login.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,206 @@
+use strict;
+use warnings;
+
+package CASPlus::Action::Login;
+use base qw/CASPlus::Action Jifty::Action/;
+
+=head1 NAME
+
+CASPlus::Action::Login - Login form and handling
+
+=head1 DESCRIPTION
+
+This provides the login form used by CAS+ to authenticate an incoming user.
+
+=head1 SCHEMA
+
+The action accepts the following parameters:
+
+=head2 lt
+
+This is a login token. This is used to prevent a client from being able to hit the back button and replay authentication using the browser history. The login token is provided automatically in a hidden input.
+
+=head2 username
+
+This is the text field requesting the client's username.
+
+=head2 password
+
+This is the password field requesting the client's password.
+
+=head2 service
+
+If the client has reached the login form on behalf of a service, this will be set to the URL location of that service for the redirect.
+
+=cut
+
+use Jifty::Param::Schema;
+use Jifty::Action schema {
+    param 'lt';
+        is mandatory,
+        render as 'Hidden';
+    param 'username' =>
+        label is 'Username',
+        is mandatory;
+    param 'password' =>
+        label is 'Password',
+        is mandatory,
+        render as 'Password';
+    param 'service' =>
+        render as 'Hidden';
+    param 'warn' =>
+        label is 'Warn me whenever I login to another service?',
+        renders as 'Checkbox';
+};
+
+=head1 METHODS
+
+=head2 take_action
+
+Performs the login process as described by the CAS protocol. This performs the following tasks:
+
+=over
+
+=item 1.
+
+Verifies the login ticket given in "lt" to make sure it is valid. If it is not, the action fails. If it is, the login ticket is invalidated and the lgoin process continues.
+
+=item 2.
+
+Checks to make sure the given username and password match a record in the database. If not, the action fails. If it does, login continues.
+
+=item 3.
+
+Attaches the matching user record to the Jifty session for use within the application.
+
+=item 4.
+
+If "service" was given, generates a service ticket to return to the service.
+
+=item 5.
+
+If "warn" was given, the session is marked for warnings.
+
+=back
+
+=cut
+
+sub take_action {
+    my $self = shift;
+
+    my $warn     = $self->argument_value('warn');
+    my $lt       = $self->argument_value('lt');
+    my $username = $self->argument_value('username');
+    my $password = $self->argument_value('password');
+    my $service  = $self->argument_value('service');
+
+    my $login_ticket = CASPlus::Model::LoginAttempt->new;
+    $login_ticket->load_by_cols( login_ticket => $lt);
+
+    # Does the login ticket exist and is it valid?
+    if ($login_ticket->is_valid) {
+
+        # Immediately invalidate the ticket, it cannot be used again
+        $login_ticket->set_current_valid_ticket(0);
+
+        # Load the user object
+        my $user = CASPlus::Model::User->new;
+        $user->load_by_cols( username => $username );
+
+        # Check for username/password match
+        if ($user->id && $user->password_is($password)) {
+            
+            # Success!
+            $self->result->message('Your login was successful.');
+            $self->log->info('LOGIN SUCCESS for '.$username);
+
+            # Setup the CurrentUser for this application
+            Jifty->web->current_user(
+                CASPlus::CurrentUser->new( id => $user->id )
+            );
+
+            # Find out how long the TGC should live
+            my $duration = Jifty->config->app('Login')->{LoginDuration}
+                        || 'forever';
+
+            # Now create the expiration, if duration isn't forever
+            my $expiration;
+            if ($duration ne 'forever') {
+                $expiration = DateTime->now->add( %$duration );
+            }
+            
+            # Create the TGC
+            my $ticket_granting_cookie = CASPlus::Model::SSOSession->new;
+            $ticket_granting_cookie->create(
+                authenticated_user    => $user,
+                warn_on_service_login => $warn,
+                expiration_time       => $expiration,
+            );
+
+            $ticket_granting_cookie->set_cookie;
+
+            # Do we need to create a service ticket too?
+            if ($service) {
+
+                # Create the service ticket
+                my $service_ticket = CASPlus::Model::ServiceSession->new;
+                $service_ticket->create(
+                    sso_session    => $ticket_granting_cookie,
+                    service_url    => $service,
+                    renewal_ticket => 1,
+                );
+
+                $self->result->content(
+                    ticket => $service_ticket->service_ticket,
+                );
+
+                $self->log->info(
+                    'SERVICE TICKET SENT for '.$service.' on behalf of '
+                        .$username);
+            }
+        } 
+
+        # Invalid username or password
+        else {
+            $self->result->error(
+                'Sorry, your username or password was not typed correctly. '.
+                'Please make sure CAPS lock is set correctly and try again.');
+
+            if ($user->id) {
+                $self->log->warn(
+                    'LOGIN FAILURE Bad password attempted for '.$username);
+            }
+
+            else {
+                $self->log->warn(
+                    'LOGIN FAILURE Bad username attempted for '.$username);
+            }
+        }
+    }
+
+    # Invalid or missing login ticket
+    else {
+        $self->result->error(
+            'There was a problem with the login form, please try again.');
+
+        $self->log->warn(
+            'LOGIN FAILURE Bad login ticket used by '.$username);
+    }
+}
+
+=head1 SEE ALSO
+
+L<http://www.ja-sig.org/products/cas/overview/protocol/index.html>
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/Action/LoginCheck.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Action/LoginCheck.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,159 @@
+use strict;
+use warnings;
+
+package CASPlus::Action::LoginCheck;
+use base qw/CASPlus::Action Jifty::Action/;
+
+=head1 NAME
+
+CASPlus::Action::LoginCheck - Preliminary login check action
+
+=head1 DESCRIPTION
+
+When reaching the login page, this check is run to see if the client has already logged in. If so, this action returns success and the user will either be redirected back to the service he came from or shown a success page. If not, this action returns failure and the user will be shown the login screen.
+
+=head1 SCHEMA
+
+This action uses the following parameters:
+
+=head2 service
+
+This is the URL of the service that has requested authentication.
+
+=head2 renew
+
+If this parameter is set to anything, the user will be required to login again whether they have done so already or not. If this is set, this action will definitely fail.
+
+=head2 gateway
+
+If this parameter is set to anything, the user will not be asked to login at all. If this is set (and L</renew> is not), this action will definitely succeed, but the user isn't really logged in.
+
+=cut
+
+use Jifty::Param::Schema;
+use Jifty::Action schema {
+    param 'service';
+    param 'renew';
+    param 'gateway';
+};
+
+=head2 take_action
+
+This action makes the following decisions:
+
+=over
+
+=item 1.
+
+If "renew" is set, fail.
+
+=item 2.
+
+If "gateway" is set, succeed. If the user is logged in, generate a service ticket to return to the service, if "service" was given. Note that the user wishes to be warned if the session has the warning flag set.
+
+=item 3.
+
+If the user is logged in, succeed. Generate a service ticket to return to the service, if "service" was given. Note that the user wishes to be warned if the session has the warning flag set.
+
+=item 4.
+
+If the user is not logged in, fail.
+
+=back
+
+=cut
+
+sub take_action {
+    my $self = shift;
+    
+    # Get the service argument, if given
+    my $service = $self->argument_value('service');
+    my $renew   = $self->argument_value('renew');
+    my $gateway = $self->argument_value('gateway');
+
+    # Force the renewal
+    if ($renew) {
+        $self->result->failure(1);
+        return;
+    }
+
+    # Load the SSO session from the TGC, if present
+    my $ticket_granting_cookie = CASPlus::Model::SSOSession->new;
+    $ticket_granting_cookie->load_from_cookie;
+
+    # The cookie is defined
+    if ($ticket_granting_cookie->id) {
+
+        # If the session exists and is valid...
+        if ($ticket_granting_cookie->is_valid) {
+
+            # Report success
+            $self->result->message('Your login information is current.');
+            $self->log->info(
+                "LOGIN RESUMED for "
+                    .$ticket_granting_cookie->authenticated_user->username);
+
+            # If service is given create the service ticket and add to result
+            if ($service) {
+                my $service_ticket = CASPlus::Model::ServiceSession->new;
+                $service_ticket->create(
+                    sso_session    => $ticket_granting_cookie,
+                    service_url    => $service,
+                    renewal_ticket => 0,
+                );
+
+                $self->result->content( 
+                    ticket => $service_ticket->service_ticket);
+                $self->result->content(
+                    warn => $ticket_granting_cookie->warn_on_service_login);
+
+                $self->log->info(
+                    "SERVICE TICKET SENT for ".$service." on behalf of "
+                        .$ticket_granting_cookie->authenticated_user->username);
+            }
+
+        }
+
+        # The cookie was not found or was not valid, failure
+        else {
+            $self->result->error(
+                'Your login has expired or you have logged out.');
+
+            $self->log->info('LOGIN EXPIRED for '
+                .$ticket_granting_cookie->authenticated_user->username);
+        }
+    }
+
+    # No cookie was found, failure
+    else {
+        $self->result->error('You are not currently logged in.');
+
+        # Check to see if a cookie was given, but not TGC was matched
+        if ($ticket_granting_cookie->fetch_cookie) {
+            $self->log->warn('LOGIN INVALID with bad cookie '
+                .' during login discovery.');
+        }
+
+        # No cookie, not currently logged
+        else {
+            $self->log->info('LOGIN MISSING during login discovery.');
+        }
+    }
+}
+
+=head1 SEE ALSO
+
+L<http://www.ja-sig.org/products/cas/overview/protocol/index.html>
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/Action/Logout.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Action/Logout.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,74 @@
+use strict;
+use warnings;
+
+package CASPlus::Action::Logout;
+use base qw/CASPlus::Action Jifty::Action/;
+
+=head1 NAME
+
+CASPlus::Action::Logout - Perform logout for the user
+
+=head1 DESCRIPTION
+
+This action is taken to invalidate the client's SSO session. All tickets that have been generated related to the SSO session are invalidated.
+
+=head1 SCHEMA
+
+This action takes no parameters.
+
+=cut
+
+use Jifty::Param::Schema;
+use Jifty::Action schema {
+
+};
+
+=head1 METHODS
+
+=head2 take_action
+
+This action removes the current user from the Jifty session and invalidates the the SSO session, which invalidates all associated service tickets, proxy tickets, and proxy granting tickets.
+
+=cut
+
+sub take_action {
+    my $self = shift;
+    
+    # Load the TGC
+    my $ticket_granting_cookie = CASPlus::Model::SSOSession->new;
+    $ticket_granting_cookie->load_from_cookie;
+
+    # If that exists...
+    if ($ticket_granting_cookie->id) {
+
+        # Invalidate the ticket
+        $ticket_granting_cookie->set_current_valid_ticket(0);
+
+        # Invalidate all service tickets
+        my $service_tickets = $ticket_granting_cookie->service_tickets;
+        while (my $service_ticket = $service_tickets->next) {
+            $service_ticket->set_current_valid_ticket(0);
+        }
+    }
+
+    Jifty->web->current_user(CASPlus::CurrentUser->new);
+
+    $self->result->success('You have been logged out.');
+}
+
+=head1 SEE ALSO
+
+L<http://www.ja-sig.org/products/cas/overview/protocol/index.html>
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/Action/Proxy.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Action/Proxy.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,130 @@
+use strict;
+use warnings;
+
+package CASPlus::Action::Proxy;
+use base qw/CASPlus::Action Jifty::Action/;
+
+=head1 NAME
+
+CASPlus::Action::Proxy - Generates proxy tickets
+
+=head1 DESCRIPTION
+
+This generates a proxy ticket based upon a given proxy granting ticket and target service identifier.
+
+=head1 SCHEMA
+
+This action takes the following parameters:
+
+=head2 pgt
+
+This is the proxy granting ticket to use to attach the proxy ticket to
+
+=head2 targetService
+
+This is a service identifier for the service that will consume the proxy ticket.
+
+=cut
+
+use Jifty::Param::Schema;
+use Jifty::Action schema {
+    param 'pgt';
+    param 'targetService';
+};
+
+=head1 METHODS
+
+=head2 take_action
+
+This action performs the following process:
+
+=over
+
+=item 1.
+
+Verifies that both arguments are present and valid. If not, fails. If so, continues.
+
+=item 2.
+
+Succeeds, generates a new proxy ticket, and attaches to the response.
+
+=back 
+
+=cut
+
+sub take_action {
+    my $self = shift;
+    
+    my $pgt            = $self->argument_value('pgt');
+    my $target_service = $self->argument_value('targetService');
+
+    if (!$pgt) {
+        $self->result->error('Missing required pgt parameter.');
+        $self->result->content( code => 'INVALID_REQUEST' );
+        return;
+    }
+
+    if (!$target_service) {
+        $self->result->error('Missing required targetService parameter.');
+        $self->result->content( code => 'INVALID_REQUEST' );
+        return;
+    }
+
+    my $proxy_grant_ticket = CASPlus::Model::ProxyGrantSession->new;
+    $proxy_grant_ticket->load_by_cols(
+        proxy_granting_ticket => $pgt,
+    );
+
+    if ($proxy_grant_ticket->is_valid) {
+        my $proxy_ticket = CASPlus::Model::ProxySession->new;
+        $proxy_ticket->create(
+            proxy_grant_session => $proxy_grant_ticket,
+            service_identifier  => $target_service,
+        );
+
+        $self->log->info('PROXY SUCCESS Granting proxy ticket '
+            .$proxy_ticket->proxy_ticket.' to service '
+            .$proxy_grant_ticket->service_session->service_url.' targeting '
+            .$proxy_ticket->service_identifier.' on behalf of '
+            .$proxy_grant_ticket->service_session
+                ->sso_session->authenticated_user);
+
+        $self->result->message('Successfully created a proxy ticket.');
+        $self->result->content( ticket => $proxy_ticket->proxy_ticket );
+    }
+
+    else {
+        if ($proxy_grant_ticket->id) {
+            $self->log->error(
+                "PROXY FAILED Proxy granting ticket no longer valid: $pgt");
+        }
+
+        else {
+            $self->log->error(
+                "PROXY FAILED No such proxy granting ticket: $pgt");
+        }
+
+        $self->result->error("Invalid proxy granting ticket: $pgt");
+        $self->result->content( code => 'BAD_PGT' );
+    }
+
+    return 1;
+}
+
+=head1 SEE ALSO
+
+L<http://www.ja-sig.org/products/cas/overview/protocol/index.html>
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/Action/ProxyValidate.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Action/ProxyValidate.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,204 @@
+use strict;
+use warnings;
+
+package CASPlus::Action::ProxyValidate;
+use base qw/CASPlus::Action::Validate Jifty::Action/;
+
+=head1 NAME
+
+CASPlus::Action::ProxyValidate - performs proxy ticket validation
+
+=head1 DESCRIPTION
+
+This provides the same functionality as L<CASPlus::Action::Validate> (and, in fact, inherits from that action) and also provides the ability to validate proxy tickets.
+
+=head1 SCHEMA
+
+This action inherits from L<CASPlus::Action::Validate>, so it just takes the same parameters as that action. This describes the slightly different use applied to those arguments:
+
+=head2 service
+
+This is a service identifier, which may or may not be a URL.
+
+=head2 ticket
+
+This is the proxy ticket or service ticket being validated.
+
+=head2 pgtUrl
+
+The same as in L<CASPlus::Action::Validate>.
+
+=head2 renew
+
+This parameter is ignored for proxy ticket validation. It doesn't make any sense since proxy tickets cannot be given on renewals.
+
+=cut
+
+use Jifty::Param::Schema;
+use Jifty::Action schema {
+};
+
+=head1 METHODS
+
+=head2 take_action
+
+This action performs the following:
+
+=over
+
+=item 1.
+
+Verifies that the request is complete and that all the information is valid. It fails if it is not.
+
+=item 2.
+
+If the request is for service validation, shifts control to L<CASPlus::Action::Validate/take_action>.
+
+=item 3.
+
+Verifies that the proxy ticket is valid. If not, fails.
+
+=item 4.
+
+If the proxy ticket is valid, it invalidates the proxy ticket.
+
+=item 5. 
+
+If "pgtUrl" is given, attempts to call back to that URL to send the PGT and attaches the PGTIOU if the call back succeeds.
+
+=item 6.
+
+It attaches the username to the result and returns success.
+
+=back
+
+=cut
+
+sub take_action {
+    my $self = shift;
+
+    return unless $self->request_is_valid;
+
+    # Load the validation arguments
+    my $ticket  = $self->argument_value('ticket');
+
+    # They have asked for service validation, use the super implementation
+    if ($ticket =~ /^ST-/) {
+        $self->SUPER::take_action;
+        return;
+    }
+
+    # Assuming they have asked for proxy validation
+    else {
+        my $service = $self->argument_value('service');
+
+        # Proxy ticket renewal doesn't make sense, renew is ignored.
+        
+        # Load the proxy ticket
+        my $proxy_ticket = CASPlus::Model::ProxySession->new;
+        $proxy_ticket->load_by_cols(
+            service_identifier => $service,
+            proxy_ticket       => $ticket,
+        );
+
+        # Check for validity
+        if ($proxy_ticket->is_valid) {
+            
+            # This is a valid proxy ticket, send success
+            $self->result->message('Proxy ticket is valid.');
+
+            my $username
+                = $proxy_ticket
+                 ->proxy_grant_session
+                 ->service_session
+                 ->sso_session
+                 ->authenticated_user
+                 ->username;
+
+            $self->log->info('PROXY TICKET SUCCESS for service '
+                .$service.' on behalf of '.$username);
+
+            # Invalidate the proxy ticket, it's only valid for one check
+            $proxy_ticket->set_current_valid_ticket(0);
+
+            # Add the username to the results
+            $self->result->content( username => $username );
+
+            # Perform the proxy grant request if they made one
+            $self->call_proxy_grant_url(
+                $proxy_ticket,
+            );
+
+            # Return the list of nested proxies
+            $self->result->content( proxies => $proxy_ticket->proxy_urls );
+        }
+
+        # Otherwise, the validation failed
+        else {
+
+            # Load the ticket for sure, if it exists, but possible service
+            # mismatch
+            $proxy_ticket->load_by_cols(
+                proxy_ticket => $ticket,
+            );
+
+            # Failed because the ticket is invalid
+            if (!$proxy_ticket->is_valid) {
+                $self->result->error("Proxy ticket $ticket is not valid.");
+                $self->result->content( code => 'INVALID_TICKET' );
+
+                # Does it even exit?
+                if ($proxy_ticket->id) {
+                    $self->log->info('PROXY TICKET FAILED '
+                        ."Invalid ticket $ticket for service $service");
+                }
+
+                # Nope, log it
+                else {
+                    $self->log->info('PROXY TICKET FAILED '
+                        ."Ticket $ticket for service $service does not exist");
+                }
+            }
+
+            # Failed, but ticket is valid
+            elsif ($proxy_ticket->is_valid 
+                    && $proxy_ticket->service_identifier ne $service) {
+
+                $self->result->error("Service $service did not match ticket "
+                    ."$ticket.");
+                $self->result->content( code => 'INVALID_SERVICE' );
+
+                $self->log->info('PROXY TICKET FAILED '
+                    ."Service mismatch for ticket $ticket and "
+                    ."service $service");
+            }
+
+            # How did we get here?
+            else {
+                $self->result->error('Internal error.');
+                $self->result->content( code => 'INTERNAL_ERROR' );
+                $self->log->info('SERVICE TICKET FAILED Internal error.');
+            }
+        }
+    }
+    
+    return 1;
+}
+
+=head1 SEE ALSO
+
+L<http://www.ja-sig.org/products/cas/overview/protocol/index.html>
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/Action/Validate.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Action/Validate.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,349 @@
+use strict;
+use warnings;
+
+package CASPlus::Action::Validate;
+use base qw/CASPlus::Action Jifty::Action/;
+
+=head1 NAME
+
+CASPlus::Action::Validate - Validates a service ticket
+
+=head1 DESCRIPTION
+
+Checks to see if a service ticket is valid.
+
+=head1 SCHEMA
+
+This action takes the following parameters:
+
+=head2 service
+
+The URL of the service validating the ticket.
+
+=head2 ticket
+
+The service ticket being validated.
+
+=head2 pgtUrl
+
+The callback URL this action should contact to provide a proxy granting ticket.
+
+=head2 renew
+
+If set, the service ticket must be a renewal ticket for validation to succeed.
+
+=cut
+
+use LWP::UserAgent;
+use URI;
+
+use Jifty::Param::Schema;
+use Jifty::Action schema {
+    param 'service';
+    param 'ticket';
+    param 'pgtUrl';
+    param 'renew';
+};
+
+=head1 METHODS
+
+=head2 request_is_valid
+
+This method checks to see if the request includes all required parameters.
+
+=cut
+
+sub request_is_valid {
+    my $self = shift;
+
+    my $service = $self->argument_value('service');
+    my $ticket  = $self->argument_value('ticket');
+
+    if (!$service) {
+        $self->result->error('Missing required service parameter.');
+        $self->result->content( code => 'INVALID_REQUEST' );
+        return 0;
+    }
+
+    if (!$ticket) {
+        $self->result->error('Missing required ticket parameter.');
+        $self->result->content( code => 'INVALID_REQUEST' );
+        return 0;
+    }
+
+    return 1;
+}
+
+=head2 call_proxy_grant_url
+
+  $self->call_proxy_grant_url($session);
+
+This method performs the work of contacting the L</pgtUrl>, if the parameter is given.
+
+=over
+
+=item $session
+
+This is a reference to a L<CASPlus::Model::ServiceSession> or L<CASPlus::Model::ProxySession> object.
+
+=back
+
+=cut
+
+sub call_proxy_grant_url {
+    my $self           = shift;
+    my $service_ticket = shift;
+    my $pgt_url        = $self->argument_value('pgtUrl');
+
+    my $proxy_ticket;
+    if ($service_ticket->isa('CASPlus::Model::ProxySession')) {
+        $proxy_ticket   = $service_ticket;
+        $service_ticket = $proxy_ticket->proxy_grant_session->service_session;
+    }
+
+    # Requesting a proxy grant ticket
+    if ($pgt_url) {
+
+        # Need a user agent to call them back them with
+        my $ua = $self->user_agent;
+
+        # Is SSL required?
+        my $require_ssl 
+            = Jifty->config->app('Proxy')->{'RequireSecureProxies'};
+        my $uri = URI->new($pgt_url);
+        if ($require_ssl && $uri->scheme ne 'https') {
+            $self->log->error("not touching a non-SSL proxy: $pgt_url");
+        }
+        
+        # If not or HTTPS requirement passed...
+        else {
+
+            # Create the proxy grant ticket
+            my $pgt = CASPlus::Model::ProxyGrantSession->new;
+            $pgt->create(
+                service_session => $service_ticket,
+                callback_url    => $pgt_url,
+                proxy_session   => $proxy_ticket,
+            );
+
+            # Contact the callback URL with pgt and pgtIou
+            my $response = $ua->get(
+                $pgt_url 
+                    .'?pgt='.$pgt->proxy_granting_ticket
+                    .'&pgtIou='.$pgt->proxy_granting_iou
+            );
+
+            my $username = $service_ticket
+                            ->sso_session
+                            ->authenticated_user
+                            ->username;
+
+            # Successful contact (possibly redirected)
+            if ($response->is_success) {
+
+                $self->log->info('PROXYING GRANTED on '
+                    .(defined $proxy_ticket 
+                        ? 'proxy '.$proxy_ticket->proxy_ticket
+                        : 'service '.$service_ticket->service_ticket)
+                    .' with callback URL '.$pgt_url
+                    .' on behalf of '.$username
+                    .' via IOU '.$pgt->proxy_granting_iou);
+
+                # Return the pgtIou
+                $self->result->content(
+                    proxy_granting_ticket => $pgt->proxy_granting_iou,
+                );
+
+            }
+
+            # Unsuccessful contact
+            else {
+                # Make the ticket invalid
+                $pgt->set_current_valid_ticket(0);
+
+                $self->log->error('PROXYING FAILED on '
+                    .(defined $proxy_ticket
+                        ? 'proxy '.$proxy_ticket->proxy_ticket
+                        : 'service '.$service_ticket->service_ticket)
+                    .' with callback URL '.$pgt_url
+                    .' on behalf of '.$username
+                    .' via IOU '.$pgt->proxy_granting_iou
+                    .': '.$response->status_line);
+            }
+        }
+    }
+
+}
+
+=head2 take_action
+
+This performs the work of validating service tickets by the following process:
+
+=over
+
+=item 1.
+
+Checks to see that the request is valid and fails if it is not.
+
+=item 2.
+
+Loads the service ticket and verifies it's validity. The action fails if the service ticket is not valid.
+
+=item 3.
+
+If the service ticket is valid, invalidates the service ticket.
+
+=item 4.
+
+Checks to see if the service ticket was a renewal if a renewal is required. Fails if it is required and the service ticket is not a renewal.
+
+=item 5.
+
+If "pgtUrl" is given, attempts to call back to that URL to send the PGT and attaches the PGTIOU if the call back succeeds.
+
+=item 6.
+
+It attaches the username to the result and returns success.
+
+=back
+
+=cut
+
+sub take_action {
+    my $self = shift;
+
+    return unless $self->request_is_valid;
+
+    # Load the validation arguments
+    my $service = $self->argument_value('service');
+    my $ticket  = $self->argument_value('ticket');
+    my $renew   = $self->argument_value('renew');
+    my $pgt_url = $self->argument_value('pgtUrl');
+
+    # Load the service ticket
+    my $service_ticket = CASPlus::Model::ServiceSession->new;
+    $service_ticket->load_by_cols(
+        service_url    => $service,
+        service_ticket => $ticket,
+    );
+
+    # Does it exist and is it valid? Also, either they must not care if this
+    # is a renewal OR it must be a renewal because they care.
+    if ($service_ticket->is_valid 
+            && (!$renew || $service_ticket->renewal_ticket)) {
+
+        # This is a valid service ticket, send success
+        $self->result->message('Service ticket is valid.');
+        
+        my $username 
+            = $service_ticket
+                ->sso_session
+                ->authenticated_user
+                ->username;
+
+        $self->log->info('SERVICE TICKET SUCCESS for service '
+            .$service.' on behalf of '.$username);
+
+        # Invalidate the service ticket, it's only valid for one check
+        $service_ticket->set_current_valid_ticket(0);
+
+        # Add the username to the results
+        $self->result->content( username => $username);
+
+        # Perform the proxy grant request if they made one
+        $self->call_proxy_grant_url($service_ticket);
+    }
+
+    # Otherwise, the validation failed
+    else {
+
+        # Load the ticket for sure, if it exists, but possible service mismatch
+        $service_ticket->load_by_cols(
+            service_ticket => $ticket,
+        );
+
+        # Failed due to renewal
+        if ($service_ticket->is_valid && $renew 
+                && !$service_ticket->renewal_ticket) {
+
+            # If this failed because of renewal, but is otherwise a valid
+            # service ticket, we need to invalidate the ticket too.
+            $service_ticket->set_current_valid_ticket(0);
+
+            $self->result->error("Service ticket $ticket is not a renewal.");
+            $self->result->content( code => 'INVALID_TICKET' );
+
+            $self->log->info('SERVICE TICKET FAILED '
+                ."Renewal requested but ticket $ticket for service $service "
+                .'is not a renewal');
+        }
+
+        # Failed because of a service mismatch
+        elsif ($service_ticket->id 
+                && $service_ticket->service_url ne $service) {
+
+            $self->result->error("Service $service did not match ticket "
+                ."$ticket.");
+            $self->result->content( code => 'INVALID_SERVICE' );
+
+            $self->log->info('SERVICE TICKET FAILED '
+                ."Service mismatch for ticket $ticket and "
+                ."service $service");
+
+        }
+
+        # Failed because the ticket was invalid
+        elsif (!$service_ticket->is_valid) {
+            $self->result->error("Service ticket $ticket is not valid.");
+            $self->result->content( code => 'INVALID_TICKET' );
+
+            # Does it even exit?
+            if ($service_ticket->id) {
+                $self->log->info('SERVICE TICKET FAILED '
+                    ."Invalid ticket $ticket for service $service");
+            }
+
+            # Nope, log it.
+            else {
+                $self->log->info('SERVICE TICKET FAILED '
+                    ."Ticket $ticket for service $service does not exist");
+            }
+        }
+
+        else {
+            $self->result->error('Internal error.');
+            $self->result->content( code => 'INTERNAL_ERROR' );
+            $self->log->info('SERVICE TICKET FAILED Internal error.');
+        }
+    }
+}
+
+my $user_agent;
+sub user_agent {
+    my $self = @_;
+
+    if (!defined $user_agent) {
+        $user_agent = LWP::UserAgent->new(
+            agent => "CASPlus Validator/$CASPlus::VERSION",
+        );
+    }
+
+    return $user_agent;
+}
+
+=head1 SEE ALSO
+
+L<http://www.ja-sig.org/products/cas/overview/protocol/index.html>
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/CurrentUser.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/CurrentUser.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,50 @@
+use strict;
+use warnings;
+
+package CASPlus::CurrentUser;
+
+use base qw/ Jifty::CurrentUser /;
+
+=head1 NAME
+
+CASPlus::CurrentUser - The current user object for CAS+
+
+=head1 DESCRIPTION
+
+This is a standard L<Jifty::CurrentUser> extension that attaches current users to L<CASPlus::Model::User> objects.
+
+=head1 METHODS
+
+=head2 _init
+
+Performs basic initialization of the current user object.
+
+=cut
+
+sub _init {
+    my $self = shift;
+    my %args = @_;
+
+    if (delete $args{_bootstrap}) {
+        $self->is_bootstrap_user(1);
+    }
+
+    elsif (keys %args) {
+        $self->user_object(CASPlus::Model::User->new(current_user => $self));
+        $self->user_object->load_by_cols(%args);
+    }
+
+    $self->SUPER::_init(%args);
+}
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;

Added: CASPlus/trunk/lib/CASPlus/Dispatcher.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Dispatcher.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,358 @@
+use strict;
+use warnings;
+
+package CASPlus::Dispatcher;
+use Jifty::Dispatcher -base;
+
+use CASPlus::Action::LoginCheck;
+use CASPlus::Action::Login;
+use CASPlus::Action::Logout;
+use CASPlus::Action::Validate;
+
+=head1 NAME
+
+CASPlus::Dispatcher - Dispatcher for CAS+
+
+=head1 DESCRIPTION
+
+This class contains the rules that determine how requests are handled in CAS+.
+
+=head1 CAS RULES
+
+The following dispatcher rules are related to the CAS 2.0 protocol.
+
+=head2 ROOT
+
+Automatically redirects to L</login>.
+
+=cut
+
+on '' => redirect '/login';
+
+=head2 GET login
+
+Performs the L<CASPlus::Model::LoginCheck> to see if the user is logged. The following response may be rendered:
+
+=over
+
+=item *
+
+If the login check succeeds and the user is coming from a service and "warn" is not attached to the result, the client is immediately redirected back to the calling service.
+
+=item *
+
+If the login check succeeds and the user is coming from a service and "warn" is attached, the client is shown a success message telling them of the service.
+
+=item *
+
+If the login check succeeds and no service, the client is shown a success page telling them that they are logged in.
+
+=item *
+
+If the login check fails, the client is shown the login page.
+
+=back
+
+=cut
+
+on GET 'login' => run {
+    my $service = get 'service';
+    my $renew   = get 'renew';
+    my $gateway = get 'gateway';
+
+    # Check for existing login
+    my $action = Jifty->web->new_action(
+        class     => 'LoginCheck',
+        arguments => {
+            service => $service,
+            renew   => $renew,
+            gateway => $gateway,
+        },
+    );
+    $action->run;
+
+    # If they had an existing login...
+    if ($action->result->success) {
+
+        # They've asked for a warning or did not give us a service
+        if ($action->result->content('warn')) {
+
+            # If a service was given, make sure to include the ticket so the
+            # template can give them a proper service link
+            my $ticket = $action->result->content('ticket');
+            set ticket => $ticket;
+
+            # Show them the login success page
+            show '/status';
+        }
+
+        # Return the service ticket immediately
+        else {
+
+            # Do we have a ticket?
+            if (my $ticket = $action->result->content('ticket')) {
+
+                # Send them back to the service with that ticket
+                redirect_with_ticket($service, $ticket);
+            }
+
+            # Nope, this is a gateway request
+            else {
+
+                # Send them back with no authentication information
+                Jifty->web->_redirect($service);
+            }
+        }
+    }
+
+    # No existing login or the service requires a renewal
+    else {
+        set 'lt' => CASPlus::Model::LoginAttempt->new_ticket;
+        show '/login';
+    }
+
+};
+
+=head2 POST login
+
+This happens when a login form is submitted. It calls the L<CASPlus::Model::Login> action. The following responses are sent based upon the result of this action:
+
+=over
+
+=item *
+
+If the login succeeds and is accompanied by a service, the client is redirected back to the service with a service ticket attached.
+
+=item *
+
+If the login succeeds and no service is set, the client is shown a success page.
+
+=item *
+
+If the login fails, the client is shown the login page again.
+
+=back
+
+=cut
+
+on POST 'login' => run {
+    my $username = get 'username';
+    my $password = get 'password';
+    my $lt       = get 'lt';
+    my $service  = get 'service';
+    my $warn     = get 'warn';
+
+    # The login screen uses a standard action, find it
+    my $login = Jifty->web->new_action(
+        class     => 'Login',
+        moniker   => 'login',
+        arguments => {
+            username => $username,
+            password => $password,
+            lt       => $lt,
+            service  => $service,
+            warn     => $warn,
+        },
+    );
+    $login->run;
+
+    Jifty->web->response->result( login => $login->result );
+
+    # On success...
+    if ($login->result->success) {
+        my $ticket = $login->result->content('ticket');
+        set ticket => $login->result->content('ticket');
+
+        # If warn is given, the success screen tells them about the process
+        if ($warn) {
+            show '/status';
+        }
+
+        # If service is given, send them back
+        elsif ($service) {
+            redirect_with_ticket($service, $ticket);
+        }
+
+        # Otherwise, pat them on the head
+        else {
+            show '/status';
+        }
+    }
+
+    # On failure, try, try again
+    else {
+        set 'lt'    => CASPlus::Model::LoginAttempt->new_ticket;
+        set action  => Jifty->web->new_action( class => 'Login' );
+        show '/login';
+    }
+};
+
+=head2 logout
+
+This calls the L<CASPlus::Action::Logout> action and shows a message about logging out. 
+
+If L<CASPlus::Manual::Config/AllowLogout> is set to a false value, this rule pretends that it doesn't exist.
+
+=cut
+
+on 'logout' => run {
+    if (Jifty->config->app('Login')->{'AllowLogout'}) {
+        my $logout = Jifty->web->new_action( class => 'Logout' );
+        $logout->run;
+
+        show '/logout';
+    }
+};
+
+=head2 validate
+
+This calls the L<CASPlus::Action::Validate> action and renders the response using the CAS 1.0 protocol format.
+
+=cut
+
+on 'validate' => run {
+    my $validate = Jifty->web->new_action(
+        class => 'Validate',
+        arguments => {
+            service => get 'service',
+            ticket  => get 'ticket',
+            renew   => get 'renew',
+        },
+    );
+    $validate->run;
+
+    set result => $validate->result;
+    show '/validate';
+};
+
+=head2 serviceValidate
+
+Calls the L<CASPlus::Action::Validate> action and returns the CAS 2.0 protocol response.
+
+=cut
+
+on 'serviceValidate' => run {
+    my $validate = Jifty->web->new_action(
+        class     => 'Validate',
+        arguments => {
+            service => get 'service',
+            ticket  => get 'ticket',
+            pgtUrl  => get 'pgtUrl',
+            renew   => get 'renew',
+        },
+    );
+    $validate->run;
+
+    set result => $validate->result;
+    show '/serviceValidate';
+};
+
+=head2 proxyValidate
+
+Runs L<CASPlus::Action::ProxyValidate> and shows the response message.
+
+=cut
+
+on 'proxyValidate' => run {
+    my $proxy_validate = Jifty->web->new_action(
+        class     => 'ProxyValidate',
+        arguments => {
+            service => get 'service',
+            ticket  => get 'ticket',
+            pgtUrl  => get 'pgtUrl',
+            renew   => get 'renew',
+        },
+    );
+    $proxy_validate->run;
+
+    set result => $proxy_validate->result;
+    show '/proxyValidate';
+};
+
+=head2 proxy
+
+Runs L<CASPlus::Action::Proxy> and returns the response message.
+
+=cut
+
+on 'proxy' => run {
+    my $proxy = Jifty->web->new_action(
+        class     => 'Proxy',
+        arguments => {
+            pgt           => get 'pgt',
+            targetService => get 'targetService',
+        },
+    );
+    $proxy->run;
+
+    set result => $proxy->result;
+    show '/proxy';
+};
+
+=head1 CAS+ FRONT-END RULES
+
+The following dispatcher rules are related to CAS+ customizations seen directly by the end-user and administrator.
+
+=head2 /user/me
+
+This retrieves information about the current logged user. If not user is currently logged, this is 404.
+
+=cut
+
+under 'user' => [
+
+    on 'me' => run {
+        if (Jifty->web->current_user->id) {
+            my $user   = Jifty->web->current_user->user_object;
+            my $action = Jifty->web->new_action(
+                class  => 'UpdateUser',
+                record => $user,
+            );
+
+            set rdf    => $user->as_rdf;
+            set user   => $user;
+            set action => $action;
+            show '/user/view';
+        }
+
+        else {
+            Jifty->log->error("No current user, so /user/me request ignored.");
+        }
+    },
+
+];
+
+=head1 CAS+ BACK-END RULES
+
+The following dispatcher rules are related to CAS+ customizations seen by services and not, generally, but end-users or administrators.
+
+=head1 METHODS
+
+=head2 redirect_with_ticket
+
+  $self->redirect_with_ticket($service, $ticket);
+
+This is a helper method that performs redirection to the service URL given in C<$service> and attaches the ticket given by C<$ticket>.
+
+=cut
+
+sub redirect_with_ticket {
+    my ($service, $ticket) = @_;
+
+    # TODO Jifty whines about this, should I worry?
+    $service .= $service =~ /\?/ ? '&' : '?';
+    $service .= 'ticket=' . $ticket;
+    Jifty->web->_redirect($service);
+}
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;

Added: CASPlus/trunk/lib/CASPlus/Manual/Config.pod
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Manual/Config.pod	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,124 @@
+=head1 NAME
+
+CASPlus::Manual::Config - Description of configuration directives
+
+=head1 DESCRIPTION
+
+The configuration for CAS+ is stored in F<etc/config.yml> under the C<application> section. This file is formatted using L<YAML>.
+
+=head1 DIRECTIVES
+
+Here is the list of configuration directives supported by CAS+.
+
+=head2 Login
+
+This section contains directives related to the login process.
+
+=over
+
+=item AllowLogout
+
+B<Default> 1
+
+If set, users are permitted to logout by visiting the C<logout> page. If this is not set, the C<logout> page does not exist.
+
+=item RequireSecureLogin
+
+B<Default:> 0
+
+This tells CAS+ that SSL must be used to present the login process. The TGC will have the secure field set so that the browser won't present the TGC unless through SSL. CAS+ should also present an error about the requirement when this is set, but requests to CAS+ are not secured by SSL.
+
+=item ShowLoginWarningCheckbox
+
+B<Default:> 1
+
+If this is set, the login page will include a checkbox allowing the user to request an alert whenever a service requests his login information. If this is set to 0, then the user will not be given this option.
+
+=back
+
+=head2 Proxy
+
+This section contains configuration directives related to proxying.
+
+=over
+
+=item RequireSecureProxies
+
+B<Default:> 0
+
+If this is set, CAS+ will refuse to contact a proxy callback URL unless that URL is using the HTTPS protocol. If not set, CAS+ will make no check.
+
+B<NOTE:> This default differs from the requirements of the CAS protocol specification. This default will probably change in the future.
+
+=back
+
+=head2 Tickets
+
+This section contains configuration directives related to how tickets are formatted and expire. It should contain at least one sub-section, named L</Defaults>, containing the configuration that the other sections will inherit if they do not set a particular setting.
+
+=head3 Defaults
+
+This section describes the default values the other sections will inherit if they do not explicitly override the settings set here.
+
+=over
+
+=item Format
+
+B<Default:> %p-
+
+This is the format of the identifier. This describes the prefix of the string. The identifier itself will be exactly L</Length> characters long. If this format creates an identifier that is too long, it will be truncated. If it is not long enough, the remaining characters will be filled with randomly selected characters chosen from L</Letters>.
+
+=item ExpirationTime
+
+B<Default:> minutes: 5
+
+This is the default expiration time for tickets that may expire: currently only include service tickets, proxy tickets, and ticket granting cookies. This can either be the string "forever" meaning that the cookie does not expire or it can be a hash value that can be passed to the C<add> method of L<DateTime>.
+
+=item Length
+
+B<Default:> 32
+
+The number of characters to place in the identifier. This is the exact number of characters that will always be found in the generated string.
+
+=item Letters
+
+B<Default:> A list of ASCII letters ('A' - 'Z' and 'a' - 'z'), numbers ('0' - '9') and the minus sign ('-').
+
+This option can be used to set a different character set than the default. The CAS protocol specification states that only ASCII letters, numbers, and the minus sign are permitted.
+
+=back
+
+=head3 ST
+
+These settings will override the defaults set in L</Defaults> for service tickets.
+
+=head3 PT
+
+These settings will override the defaults set in L</Defaults> for proxy tickets.
+
+=head3 PGTIOU
+
+These settings will override the defaults set in L</Defaults> for proxy granting IOUs.
+
+=head3 PGT
+
+These settings will override the defaults set in L</Defaults> for proxy granting tickets. It is recommended by the CAS protocol specification that the L</Length> be set to at least 64.
+
+=head3 LT
+
+These settings will override the defaults set in L</Defaults> for login tickets.
+
+=head3 TGC
+
+These settings will override the defaults set in L</Defaults> for ticket granting cookies. It is the policy of the CAS protocol specification that the L</ExpirationTime> be set to "forever". CAS+ comes with the L</Length> set to 64 as well.
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+

Added: CASPlus/trunk/lib/CASPlus/Model/LoginAttempt.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Model/LoginAttempt.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,118 @@
+use strict;
+use warnings;
+
+package CASPlus::Model::LoginAttempt;
+use Jifty::DBI::Schema;
+
+use constant CLASS_UUID => '4BA9E8FC-B786-11DB-9220-3BBE470BAD47';
+
+use CASPlus::Model::User;
+
+use Scalar::Defer qw/ defer /;
+
+=head1 NAME
+
+CASPlus::Model::LoginAttempt - Storage for login tickets
+
+=head1 SYNOPSIS
+
+  my $login_attempt = CASPlus::Model::LoginAttempt->new_ticket;
+  
+  if ($login_attempt->is_valid) {
+      print $login_attempt->login_ticket;
+      $login_attempt->set_current_valid_ticket(0);
+  }
+
+=head1 DESCRIPTION
+
+Each time a client visits the login page, a login attempt object is created. The login attempt generates a login ticket that is good for a single use only, which prevents an attacker from using the browser history to replay authentication on most browsers.
+
+=head1 SCHEMA
+
+Each login attempt object stores the following data:
+
+=head2 login_ticket
+
+This is the login ticket. It is automatically generated via L<CASPlus::Util/generate_ticket>.
+
+=head2 current_valid_ticket
+
+This is a boolean value that is initially set to true. If a login is attempted using this ticket, this will be set to false. It is set to false regardless of whether the login succeeds or not.
+
+=cut
+
+use CASPlus::Record schema {
+    column login_ticket =>
+        type is 'text',
+        is mandatory,
+        is distinct,
+        default is defer { CASPlus::Util->generate_ticket('LT') };
+
+    column current_valid_ticket =>
+        type is 'boolean',
+        default is 1;
+};
+
+=head1 METHODS
+
+=head2 is_valid
+
+  if ($login_attempt->is_valid) {
+      # ...
+  }
+
+Returns whether the login ticket is valid or not. This verifies that this object represents an actual record and that L</current_valid_ticket> is set to true.
+
+=cut
+
+sub is_valid {
+    my $self = shift;
+
+    return $self->id && $self->current_valid_ticket;
+}
+
+=head2 new_ticket
+
+  my $login_attempt = CASPlus::Model::LoginAttempt->new_ticket;
+
+This is a convenience constructor that quickly creates a login attempt object and creates a login record.
+
+=cut
+
+sub new_ticket {
+    my $class = shift;
+
+    my $ticket = $class->new;
+    $ticket->create;
+
+    return $ticket;
+}
+
+=head2 current_user_can
+
+  if ($login_attempt->current_user_can($right, %args)) {
+      # ...
+  }
+
+Always returns true. All users can read, write, and delete these things.
+
+=cut
+
+# TODO Should this be more restrictive?
+sub current_user_can {
+    my $self = shift;
+    return 1;
+}
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/Model/Profile.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Model/Profile.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,254 @@
+use strict;
+use warnings;
+
+package CASPlus::Model::Profile;
+use Jifty::DBI::Schema;
+
+use constant CLASS_UUID => '97DF6780-CCB0-11DB-963B-044A29635B38';
+
+use CASPlus::ProfileBase;
+use Class::ReturnValue;
+
+=head1 NAME
+
+CASPlus::Model::Profile - Configurable profiles for users, roles, etc.
+
+=head1 DESCRIPTION
+
+This model stores information about configurable profiles. Each profile represents an entity in your user store. These entities might represent people associated with user objects or other agents associated with user objects. These entities might represent groups or roles that are assigned to user objects. These entities might represent some other piece of information not directly related to either of these.
+
+=head1 SCHEMA
+
+=head2 name
+
+This is the name of the entity type. This name is human readable and should be capitalized since it may be used in headings and such. Its format is not restricted.
+
+=head2 description
+
+This is a description of the entity type.
+
+=head2 model_class
+
+When creating a new profile, do B<not> set this column. The C<model_class> will be set for you. This is the L<Jifty::Model::ModelClass> used to contain the individual objects for the entity type represented by this profile.
+
+=head2 profile_type
+
+This must be one of the following: "user", "role", or "other". These have the following significance:
+
+=over
+
+=item user
+
+If set to user, the L<model_class> will automatically be given a new mandatory column named C<user_object>, which will link every profile object to a L<CASPlus::Model::User>.
+
+=item role
+
+If set to role, the L<model_class> will automatically be given a new mandatory column named C<role_object>, which will link every profile object to a L<CASPlus::Model::Role>.
+
+=item other
+
+If set to other, nothing special is done to the profile objects. They are not linked to any other table.
+
+=back
+
+=head2 properties
+
+This is a link to a collection of L<CASPlus::Model::ProfileProperty> objects. Rather than creating L<CASPlus::Model::ModelClassColumn> objects directly to add columns to each profile type, you should add C<CASPlus::Model::ProfileProperty> objects. These contain additional bits of information that are used for determining permissions, export and import rules, how to describe the data externally, etc.
+
+=cut
+
+use CASPlus::Record schema {
+    column name =>
+        type is 'text',
+        label is 'Name',
+        is mandatory,
+        is distinct;
+
+    column description =>
+        type is 'text',
+        label is 'Description',
+        render_as 'Textarea';
+
+    column model_class =>
+        refers_to Jifty::Model::ModelClass,
+        label is 'Model class',
+        is mandatory,
+        is distinct,
+        is immutable;
+
+    column profile_type =>
+        type is 'text',
+        label is 'Profile type',
+        is mandatory,
+        valid_values are qw/ user role other /,
+        is immutable;
+
+    column properties =>
+        refers_to CASPlus::Model::ProfilePropertyCollection by 'profile';
+};
+
+=head1 METHODS
+
+=head2 before_create
+
+This is called at the start of L<Jifty::DBI::Record/create>. It makes sure that a L<Jifty::Model::ModelClass> is associated with the profile and creates any columns required by the L<profile_type>.
+
+=cut
+
+sub before_create {
+    my $self = shift;
+    my $args = shift;
+
+    # Create a ModelName out of "Model name"
+    my $name = $args->{name};
+    $name =~ s/ ^ (\d) /D$1/gx;
+    $name =~ s/ (?: (?<= \W ) | (?<= ^ ) ) (\w) /\U$1/gx;
+    $name =~ s/ \W //gx;
+
+    # Create a model class
+    my $model_class = Jifty::Model::ModelClass->new;
+    $model_class->create(
+        name          => $name,
+        description   => $args->{description},
+        super_classes => 'CASPlus::ProfileBase',
+    );
+
+    # No create unless there's a model class
+    return 0 unless $model_class->id;
+
+    # Set the model class
+    $args->{model_class} = $model_class;
+
+    if ($args->{profile_type} eq 'user') {
+
+        # Create the model class column that points back to the user object
+        my $user_column = Jifty::Model::ModelClassColumn->new;
+        $user_column->create(
+            name            => 'user_object',
+            model_class     => $model_class,
+            label_text      => 'User',
+#            mandatory       => 1,
+            distinct_value  => 1,
+            refers_to_class => 'CASPlus::Model::User',
+            storage_type    => 'int',
+        );
+
+        # Fail unless the column was created
+        return 0 unless $user_column->id;
+    }
+
+    elsif ($args->{profile_type} eq 'role') {
+
+        # Create the model class column that points back to the role object
+        my $role_column = Jifty::Model::ModelClassColumn->new;
+        $role_column->create(
+            name            => 'role_object',
+            model_class     => $model_class,
+            label_text      => 'Role',
+#            mandatory       => 1,
+            distinct_value  => 1,
+            refers_to_class => 'CASPlus::Model::Role',
+        );
+
+        # Fail unless the column was created
+        return 0 unless $role_column->id;
+    }
+
+    # Success
+    return 1;
+}
+
+=head2 load_by_profile_object
+
+  $profile->load_by_profile_object($object);
+
+This loads the C<CASPlus::Model::Profile> that describes the given object.
+
+=cut
+
+sub load_by_profile_object {
+    my $self   = shift;
+    my $object = shift;
+    my $ret    = Class::ReturnValue->new;
+
+    my $qualified_class = ref $object;
+    my ($class_name) = $qualified_class =~ /(\w+)$/;
+
+    my $model_class = Jifty::Model::ModelClass->new;
+    $model_class->load_by_cols( name => $class_name );
+
+    if ($model_class->id) {
+        return $self->load_by_cols( model_class => $model_class );
+    }
+
+    else {
+        $ret->as_error(
+            message => "$qualified_class object does not have a model class (searched for $class_name).",
+        );
+    }
+
+    return $ret;
+}
+
+=head2 load_profile_instance
+
+  my $object = CASPlus::Model::ProfileCollection->load_profile_instance(
+      $profile_type => $id,
+  );
+
+This loads a profile object type profile type and ID. This is used to implement the L<CASPlus::Model::User/profile> and L<CASPlus::Model::Role/profile> methods. It uses the C<user_object> (in case "user" is passed in C<$profile_type>) or C<role_object> (in case "role" is passed in C<$profile_type>) to find a profile object by the given ID.
+
+=cut
+
+sub load_profile_instance {
+    my $self = shift;
+    my $type = shift;
+    my $id   = shift;
+
+    my $profiles = CASPlus::Model::ProfileCollection->new;
+    $profiles->limit(
+        column => 'profile_type',
+        value  => $type,
+    );
+
+    while (my $profile = $profiles->next) {
+        my $model_class  = $profile->model_class->qualified_class;
+        my $model_object = $model_class->new;
+        $model_object->load_by_cols( "${type}_object" => $id );
+
+        return $model_object if $model_object->id;
+    }
+
+    return undef;
+}
+
+=head2 current_user_can
+
+This allows anyone to read, but only superuser to write. 
+
+In the future, this should be more sophisticated and based upon the roles and permissions granted to the current user.
+
+=cut
+
+# TODO Make this more sophisticated based upon roles and permissions.
+sub current_user_can {
+    my ($self, $right, %args) = @_;
+
+    if ($right eq 'read') {
+        return 1;
+    }
+
+    return $self->SUPER::current_user_can($right, %args);
+}
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp C<<hanenkamp at cpan.org>>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified and distributed under the same terms as Perl itself.
+
+=cut
+
+1;

Added: CASPlus/trunk/lib/CASPlus/Model/ProfileProperty.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Model/ProfileProperty.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,134 @@
+use strict;
+use warnings;
+
+package CASPlus::Model::ProfileProperty;
+use Jifty::DBI::Schema;
+
+use constant CLASS_UUID => 'FE2175BE-CCB1-11DB-B4B7-1C4A29635B38';
+
+=head1 NAME
+
+CASPlus::Model::ProfileProperty - Properties for profiles
+
+=head1 DESCRIPTION
+
+Properties are associated with profiles to describe the columns associated with
+those profiles. It provides information about permissions, import, export, etc. that is not stored in L<Jifty::Model::ModelClassColumn>.
+
+=head1 SCHEMA
+
+=head2 profile
+
+This is the L<CASPlus::Model::Profile> object to which this property belongs.
+
+=head2 name
+
+This is a human-readable name for the property. This can be anything you want, there's not restriction on format.
+
+=head2 description
+
+This is a description of the property.
+
+=head2 model_class_column
+
+When creating a property, do B<not> set this column. This column will be automatically generated for you. 
+
+This is the L<CASPlus::Model::ModelClassColumn> used to describe the actual data stored by this property.
+
+=cut
+
+use CASPlus::Record schema {
+    column profile =>
+        refers_to CASPlus::Model::Profile,
+        label is 'Profile',
+        is mandatory;
+
+    column name =>
+        type is 'text',
+        label is 'Name',
+        is mandatory,
+        is distinct;
+
+    column description =>
+        type is 'text',
+        label is 'Description',
+        render_as 'Textarea';
+
+    column model_class_column =>
+        refers_to Jifty::Model::ModelClassColumn,
+        label is 'Model class column',
+        is mandatory,
+        is distinct,
+        is immutable;
+};
+
+=head1 METHODS
+
+=head2 before_create
+
+This is called by L<Jifty::DBI::Record/create>.
+
+This creates the L<Jifty::Model::ModelClassColumn> for the property.
+
+=cut
+
+sub before_create {
+    my $self = shift;
+    my $args = shift;
+
+    # Create a column_name out of "Column Name"
+    my $name = lc $args->{name};
+    $name =~ s/ \W /_/gx;
+
+    # Create a model class column
+    # TODO Column creation is very simple; make it more flexible
+    my $model_class_column = Jifty::Model::ModelClassColumn->new;
+    $model_class_column->create(
+        model_class  => $args->{profile}->model_class,
+        name         => $name,
+        description  => $args->{descrition},
+        label_text   => $args->{name},
+        storage_type => 'text',
+    );
+
+    # No create unless there's a model class column
+    return 0 unless $model_class_column->id;
+
+    # Set the model class column
+    $args->{model_class_column} = $model_class_column;
+
+    # Success
+    return 1;
+}
+
+=head2 current_user_can
+
+This allows anyone to read, but only superuser to write. 
+
+In the future, this should be more sophisticated and based upon the roles and permissions granted to the current user.
+
+=cut
+
+# TODO Make this more sophisticated based upon roles and permissions.
+sub current_user_can {
+    my ($self, $right, %args) = @_;
+
+    if ($right eq 'read') {
+        return 1;
+    }
+
+    return $self->SUPER::current_user_can($right, %args);
+}
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp C<<hanenkamp at cpan.org>>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/Model/ProxyGrantSession.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Model/ProxyGrantSession.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,188 @@
+use strict;
+use warnings;
+
+package CASPlus::Model::ProxyGrantSession;
+use base qw/ CASPlus::Record /;
+use Jifty::DBI::Schema;
+
+use constant CLASS_UUID => '2278BEDE-C4D0-11DB-9A53-F393377E434E';
+
+use CASPlus::Model::ProxySession;
+use CASPlus::Model::ServiceSession;
+use CASPlus::Util;
+
+use Scalar::Defer qw/ defer /;
+
+=head1 NAME
+
+CASPlus::Model::ProxyGrantSession - Storage for proxy granting tickets
+
+=head1 SYNOPSIS
+
+  my $proxy_grant_session = CASPlus::Model::ProxyGrantSession->new;
+  $proxy_grant_session->create(
+      service_session => $service_session,
+      proxy_session   => $proxy_session,
+      callback_url    => 'https://www.example.com/pgtUrl',
+  );
+
+  if ($proxy_grant_session->is_valid) {
+      # ...
+  }
+
+=head1 DESCRPITION
+
+When a service validates the service ticket it has received, it may choose to request a proxy granting ticket. This ticket allows the service to provide proxy tickets to other services that also trust the CAS server but might not be able to contact the CAS server directly themselves. For example, a portal server might pass proxy tickets to portlets that contact mail or other backend services that can't use CAS directly, but could authenticate using the CAS proxy service.
+
+A proxy grant session object stores the proxy granting ticket and the proxy granting IOU. It links the proxy grant session to the service session that was established when the service validated the service ticket associated with that service session. This ultimately links the proxy grant session to the SSO session created by the client at login. Proxies may retrieve further proxy grant sessions, so this class may store a proxy session that was established as well as the service session.
+
+=head1 SCHEMA
+
+Each object of this class stores the following information:
+
+=head2 service_session
+
+This is a link to a L<CASPlus::Model::ServiceSession> object. This is the object that was validated when the proxy granting ticket was requested by the service.
+
+If this proxy grant session is associated with a L</proxy_session>, then this object represents the service session that exists at the top of the proxy session chain.
+
+=head2 proxy_session
+
+This is a link to a L<CASPlus::Model::ProxySession> object. This is the object that was validated when the proxy granting ticket was requested by the proxied services.
+
+By following the C<proxy_session> object to the nested C<proxy_grant_session>, you can walk the proxy chain.
+
+=head2 callback_url
+
+This is the URL that the proxy grant session called to pass the service or proxy the proxy granting ticket and proxy granting IOU.
+
+=head2 proxy_granting_iou
+
+This is an identifier generated by L<CASPlus::Util/generate_ticket> containing the proxy granting IOU.
+
+=head2 proxy_granting_ticket
+
+This is an identifier generated by L<CASPlus::Util/generate_ticket> containing the proxy granting ticket.
+
+=head2 current_valid_ticket
+
+This is a boolean value that states whether this ticket is valid or not. Normally, this is always set to true since proxy granting tickets are not normally invalidated until the client's SSO session is invalidated.
+
+=cut
+
+use CASPlus::Record schema {
+    column service_session =>
+        refers_to CASPlus::Model::ServiceSession,
+        label is 'Service session',
+        is mandatory;
+
+    column proxy_session =>
+        refers_to CASPlus::Model::ProxySession,
+        label is 'Nested proxy session';
+
+    column callback_url => 
+        type is 'test',
+        label is 'Callback URL',
+        is mandatory;
+
+    column proxy_granting_iou =>
+        type is 'text',
+        label is 'Proxy Granting IOU',
+        is mandatory,
+        default is defer { CASPlus::Util->generate_ticket('PGTIOU') };
+
+    column proxy_granting_ticket =>
+        type is 'text',
+        label is 'Proxy Granting Ticket',
+        is mandatory,
+        default is defer { CASPlus::Util->generate_ticket('PGT') };
+
+    column current_valid_ticket =>
+        type is 'boolean',
+        label is 'Valid?',
+        default is 1;
+};
+
+=head1 METHODS
+
+=head2 is_valid
+
+  if ($proxy_grant_session->is_valid) {
+      # ...
+  }
+
+Returns a true value if the proxy grant object represents an actual record, belongs to a valid SSO session, and has a true value in L</current_valid_ticket>. This returns false if any of those are not true.
+
+=cut
+
+sub is_valid {
+    my $self = shift;
+
+    return $self->id
+        && $self->service_session->sso_session->is_valid
+        && $self->current_valid_ticket;
+}
+
+=head2 current_user_can
+
+If the current user is the owner of this session object, he can take any action on it. Otherwise, only superuser can work with this object or even see it.
+
+=cut
+
+sub current_user_can {
+    my ($self, $right, %args) = @_;
+
+    if ($self->current_user->id) {
+
+        my $auth_user
+            = $right eq 'create' ? $args{service_session}->authenticated_user
+            :                      $self->authenticated_user;
+
+        if ($self->current_user->id == $auth_user->id) {
+            return 1;
+        }
+    }
+
+    return $self->SUPER::current_user_can($right, %args);
+}
+
+=head2 sso_session
+
+  my $sso_session = $proxy_grant_session->sso_session;
+
+Fetches the SSO session associated with this proxying grant session.
+
+=cut
+
+sub sso_session {
+    my $self = shift;
+
+    return $self->service_session->sso_session;
+}
+
+=head2 authenticated_user
+
+  my $user = $proxy_grant_session->authenticated_user;
+
+Fetches the authenticated user from the associated SSO Session.
+
+=cut
+
+sub authenticated_user {
+    my $self = shift;
+
+    return $self->service_session->sso_session->authenticated_user;
+}
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/Model/ProxySession.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Model/ProxySession.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,247 @@
+use strict;
+use warnings;
+
+package CASPlus::Model::ProxySession;
+use base qw/ CASPlus::Record /;
+use Jifty::DBI::Schema;
+
+use constant CLASS_UUID => '04667CB2-C66D-11DB-A9BD-B680377E434E';
+
+use CASPlus::Model::ProxyGrantSession;
+use CASPlus::Util;
+
+use Scalar::Defer qw/ defer /;
+
+=head1 NAME
+
+CASPlus::Model::ProxySession - Storage for proxy ticket information
+
+=head1 SYNOPSIS
+
+  my $proxy_session = CASPlus::Model::ProxySession->new;
+  $proxy_session->create(
+      proxy_grant_session => $proxy_grant_session,
+      service_identifier  => 'imap.example.com',
+  );
+
+  if ($proxy_session->is_valid) {
+      print $proxy_session->proxy_grant_session->service_session
+                          ->sso_session->authenticated_user->id;
+      $proxy_session->set_current_valid_ticket(0);
+  }
+
+=head1 DESCRIPTION
+
+The proxy session object represents the information related to a proxy ticket. A proxy ticket is handed to a proxied service, which can then validate the ticket to get a username from the CAS server. The ticket is valid for only a single use and for a limited time.
+
+=head1 SCHEMA
+
+=head2 proxy_grant_session
+
+This is a link to the L<CASPlus::Model::ProxyGrantSession> object that was used to generate the proxy ticket. By following this link you can walk the proxy chain or find the top-level service session for the proxy chain.
+
+=head2 proxy_ticket
+
+This is an automaticaly generated proxy ticket identifier. This is generated using L<CASPlus::Util/generate_ticket>.
+
+=head2 service_identifier
+
+This is an identifier uniquely identifying the service this proxy ticket is valid for. The service identifier must match the proxy validation request for the ticket if validation is to succeed.
+
+=head2 current_valid_ticket
+
+This is a boolean value representing whether or not the ticket represented by this object is valid. This is set to true when the object is created and is set to false as soon as validation is attempted on the proxy ticket.
+
+=head2 expiration_time
+
+This is an additional L<DateTime> object representing the time at which this ticket is no longer valid, even if it hasn't been validated yet. This is usually 5 minutes after the proxy session is created, but can be configured in F<etc/config.yml>. See L<CASPlus::Util/ExpirationTime> for details.
+
+=cut
+
+use CASPlus::Record schema {
+    column proxy_grant_session =>
+        refers_to CASPlus::Model::ProxyGrantSession,
+        label is 'Proxy Grant session',
+        is mandatory;
+
+    column proxy_ticket =>
+        type is 'text',
+        label is 'Proxy ticket',
+        is mandatory,
+        default is defer { CASPlus::Util->generate_ticket('PT') };
+
+    column service_identifier =>
+        type is 'text',
+        label is 'Service identifier',
+        is mandatory;
+
+    column current_valid_ticket =>
+        type is 'boolean',
+        label is 'Valid?',
+        default is 1;
+
+    column expiration_time =>
+        type is 'timestamp',
+        is mandatory,
+        filters are 'Jifty::DBI::Filter::DateTime';
+};
+
+=head1 METHODS
+
+=head2 before_create
+
+This method is called automatically by L<Jifty::DBI::Record/create>. This is used to setup the expiration time.
+
+=cut
+
+sub before_create {
+    my $self = shift;
+    my $args = shift;
+
+    $args->{expiration_time} = CASPlus::Util->expiration_time('PT');
+
+    return 1;
+}
+
+=head2 is_valid
+
+  if ($proxy_session->is_valid) {
+      # ...
+  }
+
+This returns true if the proxy ticket is valid. This returns true if all of the following are true:
+
+=over
+
+=item *
+
+The current object represents an actual record.
+
+=item *
+
+The proxy grant session this proxy session belongs to is valid.
+
+=item *
+
+The L</current_valid_ticket> stores a true value.
+
+=item *
+
+The L</expiration_time> has not yet been reached or is undefined.
+
+=back
+
+=cut
+
+sub is_valid {
+    my $self = shift;
+
+    my $now = DateTime->now;
+
+    return $self->id
+        && $self->proxy_grant_session->is_valid
+        && $self->current_valid_ticket
+        && (!defined $self->expiration_time || $now < $self->expiration_time);
+}
+
+=head2 current_user_can
+
+The current user is allowed to read, write, and delete this proxy session if the current user is the owner of the session. Otherwise, only superuser can do any of these things.
+
+=cut
+
+sub current_user_can {
+    my ($self, $right, %args) = @_;
+
+
+    if ($self->current_user->id) {
+        my $auth_id 
+            = $right eq 'create' ? $args{proxy_grant_session}->authenticated_user->id
+            :                      $self->authenticated_user->id;
+
+        if ($self->current_user->id == $auth_id) {
+            return 1;
+        }
+    }
+
+    return $self->SUPER::current_user_can($right, %args);
+}
+
+=head2 proxy_urls
+
+  my @proxies = @{ $proxy_session->proxy_urls };
+
+This method returns a reference to an array of L</callback_url>s for all the proxies in the current proxy chain. This is used to generate the response to the proxy validation request, which includes the list of proxy URLs for the proxy granting ticket requests that have been made to get to this proxy.
+
+The list is returned in order with the most recently requested callback URL listed first.
+
+=cut
+
+sub proxy_urls {
+    my $self = shift;
+    my $proxy = $self;
+
+    my @proxies;
+    while (defined $proxy && $proxy->id) {
+        push @proxies, $proxy->proxy_grant_session->callback_url;
+        $proxy = $proxy->proxy_grant_session->proxy_session;
+    }
+
+    return \@proxies;
+}
+
+=head2 service_session
+
+  my $service_session = $proxy_session->service_session;
+
+Fetches the service session associated with this proxy session;
+
+=cut
+
+sub service_session {
+    my $self = shift;
+
+    return $self->proxy_grant_session->service_session;
+}
+
+=head2 sso_session
+
+  my $sso_session = $proxy_session->sso_session;
+
+Fetches the SSO session associated with this proxy session;
+
+=cut
+
+sub sso_session {
+    my $self = shift;
+
+    return $self->proxy_grant_session->service_session->sso_session;
+}
+
+=head2 authenticated_user
+
+  my $user = $proxy_session->authenticated_user;
+
+Fetches the authenticated user associated with this proxy session.
+
+=cut
+
+sub authenticated_user {
+    my $self = shift;
+
+    return $self->proxy_grant_session->service_session
+        ->sso_session->authenticated_user;
+}
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/Model/Role.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Model/Role.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,71 @@
+use strict;
+use warnings;
+
+package CASPlus::Model::Role;
+use Jifty::DBI::Schema;
+
+use constant CLASS_UUID => '0E3ADC30-C0DA-11DB-A6B8-66B01988A606';
+
+use CASPlus::Model::RoleMemberCollection;
+
+=head1 NAME
+
+CASPlus::Model::Role - Storage for role membership
+
+=head1 DESCRIPTION
+
+The development and purpose of this class is still being considered.
+
+=head1 SCHEMA
+
+=head2 name
+
+This is the name of the role.
+
+=head2 role_members
+
+This is a L<CASPlus::Model::RoleMemberCollection> associating this role with its members.
+
+=cut
+
+use CASPlus::Record schema {
+    column name =>
+        type is 'text',
+        label is 'Name',
+        is mandatory,
+        is distinct;
+
+    column role_members =>
+        refers_to CASPlus::Model::RoleMemberCollection by 'the_role';
+};
+
+=head1 METHODS
+
+=head2 profile
+
+  my $profile = $role->profile;
+
+This fetches the profile instance linked to this role object. See L<CASPlus::Model::Profile>. (Note: The return value is B<not> an instance of L<CASPlus::Model::Profile>, but an instance of a model linked to an instance of L<CASPlus::Model::Profile>.)
+
+Returns C<undef> if no profile instance is associated with this role object.
+
+=cut
+
+sub profile {
+    my $self = shift;
+
+    return CASPlus::Model::Profile->load_profile_instance( role => $self->id );
+}
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/Model/RoleMember.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Model/RoleMember.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,53 @@
+use strict;
+use warnings;
+
+package CASPlus::Model::RoleMember;
+use Jifty::DBI::Schema;
+
+use constant CLASS_UUID => '112B4286-C0DA-11DB-8E01-67B01988A606';
+
+use CASPlus::Model::User;
+use CASPlus::Model::Role;
+
+=head1 NAME
+
+CASPlus::Model::RoleMember - Storage for user-role membership relationships
+
+=head1 DESCRIPTION
+
+This model provides a many-to-many relationship between L<CASPlus::Model::Role> and L<CASPlus::Model::User>.
+
+=head1 SCHEMA
+
+=head2 the_user
+
+This is a link to the L<CASPlus::Model::User> object being related.
+
+=head2 the_role
+
+This is a link to the L<CASPlus::Model::Role> object being related.
+
+=cut
+
+use CASPlus::Record schema {
+    column the_user =>
+        refers_to CASPlus::Model::User,
+        is mandatory;
+
+    column the_role =>
+        refers_to CASPlus::Model::Role,
+        is mandatory;
+};
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/Model/SSOSession.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Model/SSOSession.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,240 @@
+use strict;
+use warnings;
+
+package CASPlus::Model::SSOSession;
+use Jifty::DBI::Schema;
+
+use Scalar::Defer qw/ defer /;
+
+use constant CLASS_UUID => 'FC36253A-B779-11DB-9941-A8BD470BAD47';
+
+use CASPlus::Model::ServiceSessionCollection;
+use CASPlus::Model::User;
+
+=head1 NAME
+
+CASPlus::Model::SSOSession - Storage for the SSO session and TGC of a client
+
+=head1 DESCRIPTION
+
+Objects in this model represent individual SSO sessions. An SSO session is established when a user logs into CAS and terminates when the user logs out or when the ticket granting cookie (TGC) expires (usually at the end of the browser session).
+
+The SSO session records the ticket granting cookie and links that to the user object this session authenticates.
+
+=head1 SCHEMA
+
+=head2 authenticated_user
+
+This is a link to the L<CASPlus::Model::User> object that was authenticated using this SSO session.
+
+=head2 ticket_granting_cookie
+
+This is the automatically generated ticket granting cookie identifier associated with the session. This identifier is stored in a cookie on the client's web browser. It is generated using L<CASPlus::Util/generate_ticket>.
+
+=head2 login_time
+
+This is a L<DateTime> object representing the moment the SSO session was initially authenticated.
+
+=head2 logout_time
+
+This is a L<DateTime> object representing the moment the SSO session was invalidated because the client requested an explicit logout.
+
+=head2 expiration_time
+
+This is a L<DateTime> object representing the moment the SSO session will become invalid due to expiration. According to the CAS specification, SSO sessions expire when the client closes the browser session. CAS+ does this by default as well, but allows for an expiration time to also be set if desired by the CAS+ administrator.
+
+=head2 current_valid_ticket
+
+This is a boolean value that specifies whether or not the TGC is currently valid. This is set to true when the object is created. It may be set to false if the client requests an explicit logout.
+
+=head2 warn_on_service_login
+
+The client may request to be alerted whenever a service requests his login information. If the client makes such a request, this boolean value is set to true.
+
+=head2 service_tickets
+
+This is the list of L<CASPlus::Model::ServiceSession> objects that have been associated with this SSO session.
+
+=cut
+
+use CASPlus::Record schema {
+    column authenticated_user =>
+        refers_to CASPlus::Model::User,
+        is mandatory;
+
+    column ticket_granting_cookie =>
+        type is 'text',
+        is mandatory,
+        is distinct,
+        default is defer { CASPlus::Util->generate_ticket('TGC') };
+
+    column login_time =>
+        type is 'timestamp',
+        is mandatory,
+        is immutable,
+        filters are 'Jifty::DBI::Filter::DateTime',
+        default is defer { DateTime->now };
+
+    column logout_time =>
+        type is 'timestamp',
+        filters are 'Jifty::DBI::Filter::DateTime';
+
+    column expiration_time =>
+        type is 'timestamp',
+        filters are 'Jifty::DBI::Filter::DateTime';
+
+    column current_valid_ticket =>
+        type is 'boolean',
+        default is 1;
+
+    column warn_on_service_login =>
+        type is 'boolean',
+        default is 0;
+
+    column service_tickets =>
+        refers_to CASPlus::Model::ServiceSessionCollection by 'sso_session';
+};
+
+use Readonly;
+
+=head1 CONSTANTS
+
+=head2 $COOKIE_NAME
+
+This holds the name of the cookie set in the client's browser and stores the ticket granting cookie identifier. The value is "CASPlusTGC".
+
+=cut
+
+Readonly my $COOKIE_NAME => 'CASPlusTGC';
+
+=head1 METHODS
+
+=head2 before_create
+
+This method is called by L<Jifty::DBI::Record/create>. This sets up the expiration time for the ticket granting cookie, which is usually set to C<undef> to show that it never expires. This can be configured in F<etc/config.yml>. See L<CASPlus::Util/ExpirationTime> for details.
+
+=cut
+
+sub before_create {
+    my $self = shift;
+    my $args = shift;
+
+    $args->{expiration_time} = CASPlus::Util->expiration_time('TGC');
+
+    return 1;
+}
+
+=head2 is_valid
+
+  if ($sso_session->is_valid) {
+      # ...
+  }
+
+Returns a true value if the SSO session object represents a real record and L</current_valid_ticket> is set to true and L</expiration_time> is either undefined or still in the future.
+
+=cut
+
+sub is_valid {
+    my $self = shift;
+
+    my $now = DateTime->now;
+
+    return $self->id
+        && $self->current_valid_ticket 
+        && (!defined $self->expiration_time || $now < $self->expiration_time);
+}
+
+=head2 fetch_cookie
+
+  my $cookie = $sso_session->fetch_cookie;
+
+This method attempts to fetch the TGC from the client's browser.
+
+=cut
+
+sub fetch_cookie {
+    my $class = shift;
+
+    my %cookies = CGI::Cookie->fetch;
+    return $cookies{$COOKIE_NAME};
+}
+
+=head2 set_cookie
+
+  $sso_session->set_cookie;
+
+This method adds the TGC to the client browser's cookie jar. This cookie is set to expire when the browser session ends regardless of what value has been set in L</expiration_time>.
+
+The cookie set may require an SSL session if the L<CASPlus::Manual::Config/RequireSecureLogin> setting is set.
+
+=cut
+
+sub set_cookie {
+    my $self = shift;
+
+    my $cookie = CGI::Cookie->new(
+        -name   => $COOKIE_NAME,
+        -value  => $self->ticket_granting_cookie,
+        -secure => Jifty->config->app('Login')->{RequireSecureLogin},
+    );
+
+    Jifty->web->response->add_header( 'Set-Cookie' => $cookie->as_string );
+}
+
+=head2 load_from_cookie
+
+  $sso_session->load_from_cookie;
+
+Attempts to fetch the TGC from the client's browser. If a TGC is found, this method attempts to load the SSO session associated with that TGC and returns the result of the attempt.
+
+=cut
+
+sub load_from_cookie {
+    my $self = shift;
+
+    my $cookie = $self->fetch_cookie;
+
+    if (defined $cookie) {
+        return $self->load_by_cols(
+            ticket_granting_cookie => $cookie->value,
+        );
+    }
+
+    return (0, "No cookie found.");
+}
+
+=head2 current_user_can
+
+If the current user owns the SSO session, he may perform any operation on that object. Otherwise, only superuser can read, write, or delete the object.
+
+=cut
+
+sub current_user_can {
+    my ($self, $right, %args) = @_;
+    
+    if ($self->current_user->id) {
+
+        if ($right eq 'create') {
+            return 1;
+        }
+
+        if ($self->current_user->id == $self->authenticated_user->id) {
+            return 1;
+        }
+    }
+
+    return $self->SUPER::current_user_can($right, %args);
+}
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/Model/ServiceSession.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Model/ServiceSession.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,184 @@
+use strict;
+use warnings;
+
+package CASPlus::Model::ServiceSession;
+use Jifty::DBI::Schema;
+
+use constant CLASS_UUID => 'AF9CED8C-B786-11DB-905F-4CBE470BAD47';
+
+use CASPlus::Model::SSOSession;
+
+use Scalar::Defer qw/ defer /;
+
+=head1 NAME
+
+CASPlus::Model::ServiceSession - Storage for service ticket information
+
+=head1 DESCRIPTION
+
+A service session object represents a service ticket request and the associated service session. A service ticket is only valid for a single use. This object stores a link to the associated SSO session and contains information about the service ticket, the service, and current validaty of the ticket.
+
+=head1 SCHEMA
+
+=head2 sso_session
+
+This is a link to the L<CASPlus::Model::SSOSession> object to which this service session belongs.
+
+=head2 service_url
+
+This is a service identifier for the service requesting a service ticket. The CAS protocol specification is a little vague as to whether or not this must bea URL, but CAS+ assumes that this is always a URL.
+
+=head2 service_ticket
+
+This is the automatically generated service ticket identifier. It is generated using L<CASPlus::Util/generate_ticket>.
+
+=head2 current_valid_ticket
+
+This is a boolean value that is initially set to true. This value is immediately set to false when on service ticket validation---even if validation fails for any reason.
+
+=head2 renewal_ticket
+
+This is a boolean value that is set to true if the associated service ticket is being sent back from an actual login. Some services may require the user login again to reverify their identity. This stores whether or not the user just logged in as part of generating this service ticket.
+
+=head2 expiration_time
+
+This is the expiration time of the ticket. This is usually set to 5 minutes after the service ticket is created, but this is configurable. See L<Jifty::Util/ExpirationTime> for more information.
+
+=cut
+
+use CASPlus::Record schema {
+    column sso_session =>
+        refers_to CASPlus::Model::SSOSession,
+        is mandatory;
+
+    column service_url =>
+        type is 'text',
+        is mandatory;
+
+    column service_ticket =>
+        type is 'text',
+        is mandatory,
+        is distinct,
+        default is defer { CASPlus::Util->generate_ticket('ST') };
+
+    column current_valid_ticket =>
+        type is 'boolean',
+        default is 1;
+
+    column renewal_ticket =>
+        type is 'boolean';
+
+    column expiration_time =>
+        type is 'timestamp',
+        is mandatory,
+        filters are 'Jifty::DBI::Filter::DateTime';
+};
+
+=head1 METHODS
+
+=head2 before_create
+
+This method is called by L<Jifty::DBI::Record/create> just before creating teh service ticket. This method sets the expiration time according to the configuration in F<etc/config.yml>. See L<CASPlus::Util/ExpirationTime>.
+
+=cut
+
+sub before_create {
+    my $self = shift;
+    my $args = shift;
+
+    $args->{expiration_time} = CASPlus::Util->expiration_time('ST');
+
+    return 1;
+}
+
+=head2 is_valid
+
+  if ($service_session->is_valid) {
+      # ...
+  }
+
+Returns true if all of the following are true:
+
+=over
+
+=item *
+
+The service session object represents an actual record.
+
+=item *
+
+The SSO session this service session belongs to is valid.
+
+=item *
+
+The L</current_valid_ticket> is set to true.
+
+=item *
+
+The L</expiration_time> is undefined or is set to a value in the future.
+
+=back
+
+Returns false if any of the above are false.
+
+=cut
+
+sub is_valid {
+    my $self = shift;
+
+    my $now = DateTime->now;
+
+    return $self->id 
+        && $self->sso_session->is_valid
+        && $self->current_valid_ticket 
+        && (!defined $self->expiration_time || $now < $self->expiration_time);
+}
+
+=head2 authenticated_user
+
+  my $user = $service_session->authenticated_user;
+
+Fetches the authenticated user associated with this service session.
+
+=cut
+
+sub authenticated_user {
+    my $self = shift;
+
+    return $self->sso_session->authenticated_user;
+}
+
+=head2 current_user_can
+
+This grants the owner of the service ticket the ability to read, write, and delete the ticket. Otherwise, only superuser is granted these privileges.
+
+=cut
+
+sub current_user_can {
+    my ($self, $right, %args) = @_;
+
+    if ($self->current_user->id) {
+        my $auth_id
+            = $right eq 'create' ? $args{sso_session}->authenticated_user->id
+            :                      $self->authenticated_user->id;
+
+        if ($self->current_user->id == $auth_id) {
+            return 1;
+        }
+    }
+
+    return $self->SUPER::current_user_can($right, %args);
+}
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/Model/User.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Model/User.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,242 @@
+use strict;
+use warnings;
+
+package CASPlus::Model::User;
+use Jifty::DBI::Schema;
+
+use constant CLASS_UUID => '3D47B972-B779-11DB-B763-9DBD470BAD47';
+
+use CASPlus::Model::RoleMemberCollection;
+use CASPlus::Model::SSOSessionCollection;
+
+use IO::String;
+use XML::Writer;
+
+=head1 NAME
+
+CASPlus::Model::User - Storage for user objects
+
+=head1 DESCRIPTION
+
+A user object represents a single individual person's login information. In general, CAS+ expects exactly one login per person.
+
+=head1 SCHEMA
+
+=head2 username
+
+This is the username of the individual.
+
+=head2 password
+
+This is the shared secret between the CAS+ database and the individual. This value is stored in the database using an MD5 digest, which allows for comparisons, but the password itself is not retrievable.
+
+=head2 preferences
+
+This is a complex Perl object for storing individual preference information. It is stored in the database as L<YAML>. It should contain a hash reference where the keys represent different configuration fields for the individual.
+
+=head2 all_sessions
+
+This is a link to all of the L<CASPlus::Model::SSOSession> objects that are associated with this individual.
+
+=head2 member_roles
+
+This is a link to all the L<CASPlus::Model::RoleMembership> objects that are associated with this individual.
+
+=cut
+
+use CASPlus::Record schema {
+    column username =>
+        type is 'text',
+        is mandatory,
+        is distinct,
+        label is 'Username';
+
+    column password =>
+        type is 'text',
+        label is 'Password',
+        render_as 'Password',
+        filters are 'Jifty::DBI::Filter::SaltHash',
+        is unreadable;
+
+    column preferences =>
+        type is 'text',
+        label is 'Preferences',
+        render_as 'Unrendered',
+        filters are 'Jifty::DBI::Filter::YAML';
+
+    column all_sessions =>
+        refers_to CASPlus::Model::SSOSessionCollection by 'authenticated_user';
+
+    column member_roles =>
+        refers_to CASPlus::Model::RoleMemberCollection by 'the_user';
+};
+
+use Digest::MD5 qw/ md5_hex /;
+
+use CASPlus::Util;
+
+=head1 METHODS
+
+=head2 password_is
+
+  if ($user->password_is($password)) {
+      print "The password matches!\n";
+  }
+
+This method performs a comparison between the given password and the password stored in the database.
+
+=cut
+
+sub password_is {
+    my ($self, $value) = @_;
+
+    my $password = $self->__value('password');
+    my ($hash, $salt) = @$password;
+
+    return $hash eq md5_hex($value . $salt);
+}
+
+=head2 current_sessions
+
+  my $sessions = $user->current_sessions;
+
+This method returns the same set as L</all_sessions>, except it is limited to the active SSO sessions associated with the user. Only those sessions that have not yet expired and are currently valid will be returned.
+
+=cut
+
+sub current_sessions {
+    my $self = shift;
+
+    my $sessions = $self->all_sessions;
+    $sessions->limit(
+        column => 'current_valid_ticket',
+        value  => 1,
+    );
+    $sessions->limit(
+        column   => 'expiration_time',
+        operator => '>',
+        value    => DateTime->now,
+    );
+
+    return $sessions;
+}
+
+=head2 name
+
+  my $name = $user->name;
+
+This is a synonym for L</username>.
+
+=cut
+
+sub name { shift->username }
+
+=head2 profile 
+
+  my $profile = $user->profile;
+
+This fetches the profile instance linked to this user object. See L<CASPlus::Model::Profile>. (Note: The return value is B<not> an instance of L<CASPlus::Model::Profile>, but an instance of a model linked to an instance of L<CASPlus::Model::Profile>.)
+
+Returns C<undef> if no profile instance is associated with this user object.
+
+=cut
+
+sub profile {
+    my $self = shift;
+
+    return CASPlus::Model::Profile->load_profile_instance( user => $self->id );
+}
+
+=head2 current_user_can
+
+This enables the individual to read, write, and modify the user record belonging to him. Only superuser can read, write, and modify other user records.
+
+=cut
+
+sub current_user_can {
+    my ($self, $right, %args) = @_;
+
+    if ($self->current_user->id and $right ne 'create') {
+        if ($self->current_user->id == $self->id) {
+            return 1;
+        }
+    }
+
+    return $self->SUPER::current_user_can($right, %args);
+}
+
+=head2 roles
+
+This returns an array of L<CASPlus::Model::Role> objects that have been linked to the user by L<CASPlus::Model::RoleMember> relationships.
+
+=cut
+
+sub roles {
+    my $self = shift;
+
+    return map { $_->the_role } @{ $self->member_roles->item_array_ref };
+}
+
+=head2 as_rdf
+
+Returns an RDF representation of the user object as a string.
+
+=cut
+
+sub as_rdf {
+    my $self = shift;
+    
+    my $username = $self->username;
+    my $user_url = Jifty->web->url( path => '/user/' . $self->id );
+
+    my $rdfns = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#';
+    my $casns = 'http://sterling.hanenkamp.com/rdf/CASPlus#';
+
+    my $str = IO::String->new;
+    my $xml = XML::Writer->new(
+        OUTPUT     => $str,
+        NAMESPACES => 1,
+        PREFIX_MAP => {
+            $rdfns => 'rdf',
+            $casns => 'casplus',
+        },
+    );
+
+    $xml->startTag([ $casns, 'user' ], [ $rdfns, 'about' ] => $user_url);
+    $xml->dataElement([ $casns, 'username' ], $username);
+
+    my $profile = $self->profile;
+    if ($profile) {
+        my $profile_type = CASPlus::Model::Profile->new;
+        $profile_type->load_by_profile_object($profile);
+        my $properties = $profile_type->properties;
+
+        $xml->startTag([ $casns, 'profile' ]);
+
+        while (my $property = $properties->next) {
+            my $property_name = $property->model_class_column->name;
+            $xml->dataElement(
+                [ $casns, $property_name ], $profile->$property_name()
+            );
+        } 
+
+        $xml->endTag([ $casns, 'profile' ]);
+    }
+
+    $xml->endTag([ $casns, 'user' ]);
+
+    return ${ $str->string_ref };
+}
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+

Added: CASPlus/trunk/lib/CASPlus/ProfileBase.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/ProfileBase.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,43 @@
+use strict;
+use warnings;
+
+package CASPlus::ProfileBase;
+use base qw/ CASPlus::Record /;
+
+=head1 NAME
+
+CASPlus::ProfileBase - base class of all profile objects
+
+=head1 DESCRIPTION
+
+Provides some general functionality to all profile objects.
+
+=head1 METHODS
+
+=head2 current_user_can
+
+As of this writing, all users can read all profile objects, but only superuser is able to create profile objects.
+
+=cut
+
+sub current_user_can {
+    my ($self, $right, %args) = @_;
+
+    if ($right eq 'read') {
+        return 1;
+    }
+
+    return $self->SUPER::current_user_can($right, %args);
+}
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp C<<hanenkamp at cpan.org>>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified and distributed under the same terms as Perl itself.
+
+=cut
+
+1;

Added: CASPlus/trunk/lib/CASPlus/Util.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/lib/CASPlus/Util.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,169 @@
+use strict;
+use warnings;
+
+package CASPlus::Util;
+
+use DateTime;
+use List::Util qw/ shuffle /;
+use String::Format;
+
+=head1 NAME
+
+CASPlus::Util - utility functions for CAS+
+
+=head1 SYNOPSIS
+
+  # Generate ticket strings
+  my $service_ticket = CASPlus::Util->generate_ticket('ST');
+  my $proxy_ticket   = CASPlus::Util->generate_ticket('PT');
+  my $proxy_granting = CASPlus::Util->generate_ticket('PGT');
+  my $proxy_iou      = CASPlus::Util->generate_ticket('PGTIOU');
+  my $login_ticket   = CASPlus::Util->generate_ticket('LT');
+  my $grant_cookie   = CASPlus::Util->generate_ticket('TGC');
+
+=head1 DESCRIPTION
+
+Currently, this houses the ticket generator, but any general-purpose function needed by CAS+ may go here in the future.
+
+=head1 METHODS
+
+=head2 generate_ticket
+
+  my $ticket_id = CASPlus::Util->generate_ticket($prefix)
+
+This method takes care of all the details of generating tickets. Just hand it a prefix and it will return a string formatted for that ticket type.
+
+The tickets are created according to the configuration stored in F<etc/config.yml>. The default configuration should look something like this:
+
+  application:
+    Tickets:
+      Defaults:
+        Format: '%p-'
+        ExpirationTime:
+          minutes: 5
+        Length: 32
+      PGT:
+        Length: 64
+      TGC:
+        Length: 64
+        ExpirationTime: forever
+
+The values for the C<Defaults> key will be used if no overrides are given for a particular ticket/cookie prefix. See L</expiration_time>.
+
+=over
+
+=item ExpirationTime
+
+This doesn't actually effect the format of the string, but it does specify maximum length the ticket will remain valid after it is created. 
+
+The expiration time may be one of two values. It may be the word "forever" to specify no limit to the expiration time. Or it is any value that could be sent to the C<add> method of L<DateTime> objects. In the second mode, the keys are the name of a time period and the values are the number of units to offset by.
+
+This setting is only applicable to to PT, ST, and TGC tickets (though, the CAS specification doesn't specify that TGC tickets should have a limited expiration at all).
+
+=item Format
+
+This is the format that the string will take on. This format only describes the start of the string. The string will be filled to the given L</Length> with random data taken from the available L</Letters>.
+
+The following format specifiers are currently permitted:
+
+=over
+
+=item %p
+
+This is the 2 to 6 letter prefix of the identifier given to the generate function (i.e., one of ST, PT, PGT, PGTIOU, LT, or TGC).
+
+=item %%
+
+This is translated into a single percent-sign. NOTE: The percent sign is not actually an allowed character according to the CAS specification, but is included in case your implementation might need one anyway.
+
+=back
+
+=item Length
+
+This is the length of the key, including the prefix.
+
+=item Letters
+
+This is a list of letters that may be included in the randomized strings. This normally includes the latin letters in upper ('A' - 'Z') and lowercase ('a' - 'z'), the arabic numerals ('-'), and the minus-sign ('-'). These are the characters that are permitted by section 3.7 of the CAS protocol specification.
+
+=back
+
+=cut
+
+sub generate_ticket {
+    my ($class, $prefix) = @_;
+
+    # Load the configuration
+    my $ticket_config = Jifty->config->app('Tickets')->{ $prefix };
+
+    # Load the configuration directives
+    my $letters = shuffle $ticket_config->{'Letters'};
+    my $length  = $ticket_config->{'Length'};
+    my $format  = $ticket_config->{'Format'};
+
+    # Create a format specifier
+    my %args = (
+        p => $prefix,
+    );
+
+    # Build the identifier from the configured format
+    my $identifier = stringf($format, %args);
+    my $actual_length = length $identifier;
+
+    # Shorten the identifier if too long
+    if ($actual_length > $length) {
+        $identifier = substr $identifier, 0, $length;
+    }
+
+    # Lengthen the identifier if too short
+    elsif ($actual_length < $length)  {
+        my $difference = $length - $actual_length - 1;
+        $identifier .= join '', 
+                       map      { $letters->[ rand( $#$letters ) ] } 
+                                (0 .. $difference);
+    }
+
+    return $identifier;
+}
+
+=head2 expiration_time
+
+  my $datetime = CASPlus::Util->expiration_time($prefix);
+
+Returns the expiration time of the ticket type as configured in F<etc/config.yml>. See L</ExpirationTime> for details.
+
+=cut
+
+sub expiration_time {
+    my ($self, $prefix) = @_;
+
+    my $offset = Jifty->config->app('Tickets')->{$prefix}{'ExpirationTime'};
+
+    if (ref $offset) {
+        return DateTime->now->add( %$offset );
+    }
+
+    elsif ($offset =~ /^forever$/i) {
+        return;
+    }
+
+    else {
+        die "Unknown ExpirationTime for $prefix in configuration: $offset";
+    }
+}
+
+=head1 SEE ALSO
+
+L<http://www.ja-sig.org/products/cas/overview/protocol/index.html|CAS Protocol, Section 3, CAS Entities>
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp C<<hanenkamp at cpan.org>>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software; you may modify and distribute it under the same terms as Perl itself.
+
+=cut
+
+1;

Added: CASPlus/trunk/share/web/templates/_elements/header
==============================================================================
--- (empty file)
+++ CASPlus/trunk/share/web/templates/_elements/header	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,22 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
+<head>
+  <meta http-equiv="content-type" content="text/html; charset=utf-8" />
+  <meta name="robots" content="all" />
+  
+  <title><% _($title) %></title>
+  
+  <% Jifty->web->include_css %>
+  <% Jifty->web->include_javascript %> 
+% if (defined Jifty->web->request->argument('rdf')) {
+  <rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">
+    <% Jifty->web->request->argument('rdf') |n %>
+  </rdf:RDF>
+% }
+</head>
+<%args>
+$title => ""
+</%args>
+<%init>
+$r->content_type('text/html; charset=utf-8');
+</%init>

Added: CASPlus/trunk/share/web/templates/login
==============================================================================
--- (empty file)
+++ CASPlus/trunk/share/web/templates/login	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,48 @@
+<&|/_elements/wrapper, title => 'Login' &>
+
+<form method="POST" action="/login">
+% if ($service) {
+<input type="hidden" name="service" value="<% $service %>"/>
+% }
+<div class="form_field mandatory argument-username">
+    <span class="preamble text argument-username"/>
+    <label class="label text argument-username" for="username"><% _('Username') %></label>
+    <input id="username" class="widget text argument-username" type="text" name="username" value=""/>
+    <span class="hints text argument-username"/>
+    <span id="errors-username" class="error text argument-username"/>
+    <span id="warnings-username" class="warning text argument-username"/>
+    <span id="canonicalization_note-username" class="canonicalization_note text argument-username"/>
+</div>
+<div class="form_field mandatory argument-password">
+    <span class="preamble password argument-password"/>
+    <label class="label password argument-password" for="password"><% _('Password') %></label>
+    <input id="password" class="widget password argument-password" type="password" name="password" value=""/>
+    <span class="hints password argument-password"/>
+    <span id="errors-password" class="error password argument-password"/>
+    <span id="warnings-password" class="warning password argument-password"/>
+    <span id="canonicalization_note-password" class="canonicalization_note password argument-password"/>
+</div>
+% if (Jifty->config->app('Login')->{ShowLoginWarningCheckbox}) {
+<div class="form_field argument-warn">
+    <span class="preamble checkbox argument-warn"/>
+    <label class="label checkbox argument-warn" for="warn"><% _('Warn me when other services log me in.') %></label>
+    <input id="warn" class="widget password argument-warn" type="checkbox" name="warn" value="1"/>
+    <span class="hints checkbox argument-warn"><% _('You are a logging in to a service which may be used by multiple web sites. By checking this box you are asking to see a special message letting you know whenever another web site asks who you are.') %></span>
+    <span id="errors-warn" class="error checkbox argument-warn"/>
+    <span id="warnings-warn" class="warning checkbox argument-warn"/>
+    <span id="canonicalization_note-warn" class="canonicalization_node checkbox argument-warn"/>
+</div>
+% }
+<input type="hidden" name="lt" value="<% $lt->login_ticket %>"/>
+<div class="submit_button">
+    <input id="submit" class="widget button" type="submit" value="Login" name=""/>
+</div>
+
+</form>
+
+</&>
+
+<%args>
+$service => undef
+$lt
+</%args>

Added: CASPlus/trunk/share/web/templates/logout
==============================================================================
--- (empty file)
+++ CASPlus/trunk/share/web/templates/logout	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,9 @@
+<&|/_elements/wrapper, title => 'Logged out' &>
+
+% if (Jifty->web->current_user->id) {
+<p>Oddly enough, you are still logged in as <% Jifty->web->current_user->user_obj->username %>.</p>
+% } else {
+<p>You are now logged out.</p>
+% }
+
+</&>

Added: CASPlus/trunk/share/web/templates/proxy
==============================================================================
--- (empty file)
+++ CASPlus/trunk/share/web/templates/proxy	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,18 @@
+<?xml version="1.0"?>
+<cas:serviceResponse xmlns:cas="http://www.yale.edu/tp/cas">
+% if ($result->success) {
+  <cas:proxySuccess>
+    <cas:proxyTicket><% $result->content('ticket') %></cas:proxyTicket>
+  </cas:proxySuccess>
+% } else {
+  <cas:proxyFailure code="<% $result->content('code') %>">
+    <% $result->error %>
+  </cas:proxyFailure>
+% }
+</cas:serviceResponse>
+<%args>
+$result
+</%args>
+<%init>
+$r->content_type('application/xml');
+</%init>

Added: CASPlus/trunk/share/web/templates/proxyValidate
==============================================================================
--- (empty file)
+++ CASPlus/trunk/share/web/templates/proxyValidate	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,28 @@
+<?xml version="1.0"?>
+<cas:serviceResponse xmlns:cas="http://www.yale.edu/tp/cas">
+% if ($result->success) {
+    <cas:authenticationSuccess>
+        <cas:user><% $result->content('username') %></cas:user>
+% if ($result->content('proxy_granting_ticket')) {
+        <cas:proxyGrantingTicket><% $result->content('proxy_granting_ticket') %></cas:proxyGrantingTicket>
+% }
+% if ($result->content('proxies')) {
+        <cas:proxies>
+% for my $proxy (@{ $result->content('proxies') }) {
+          <cas:proxy><% $proxy %></cas:proxy>
+% }
+        </cas:proxies>
+% }
+    </cas:authenticationSuccess>
+% } else {
+    <cas:authenticationFailure code="<% $result->content('code') %>">
+        <% $result->error %>
+    </cas:authenticationFailure>
+% }
+</cas:serviceResponse>
+<%args>
+$result
+</%args>
+<%init>
+$r->content_type('application/xml');
+</%init>

Added: CASPlus/trunk/share/web/templates/serviceValidate
==============================================================================
--- (empty file)
+++ CASPlus/trunk/share/web/templates/serviceValidate	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,21 @@
+<?xml version="1.0"?>
+<cas:serviceResponse xmlns:cas="http://www.yale.edu/tp/cas">
+% if ($result->success) {
+    <cas:authenticationSuccess>
+        <cas:user><% $result->content('username') %></cas:user>
+% if ($result->content('proxy_granting_ticket')) {
+        <cas:proxyGrantingTicket><% $result->content('proxy_granting_ticket') %></cas:proxyGrantingTicket>
+% }
+    </cas:authenticationSuccess>
+% } else {
+    <cas:authenticationFailure code="<% $result->content('code') %>">
+        <% $result->error %>
+    </cas:authenticationFailure>
+% }
+</cas:serviceResponse>
+<%args>
+$result
+</%args>
+<%init>
+$r->content_type('application/xml');
+</%init>

Added: CASPlus/trunk/share/web/templates/status
==============================================================================
--- (empty file)
+++ CASPlus/trunk/share/web/templates/status	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,25 @@
+<&|/_elements/wrapper, title => 'Login Status' &>
+
+% if (Jifty->web->current_user->id) {
+<p>You are currently signed in as 
+    <% Jifty->web->link(
+        label => Jifty->web->current_user->user_object->username,
+        url   => '/user/me',
+    ) %></p>
+
+<p><% Jifty->web->link(
+        label => 'Logout',
+        url   => '/logout',
+   ) %></p>
+% } else {
+
+<p>You are not current signed in.</p>
+
+<p><% Jifty->web->link(
+        label => 'Login',
+        url   => '/login',
+   ) %></p>
+
+% }
+
+</&>

Added: CASPlus/trunk/share/web/templates/user/view
==============================================================================
--- (empty file)
+++ CASPlus/trunk/share/web/templates/user/view	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,9 @@
+<&|/_elements/wrapper, title => $user->username._(q{'s Profile}) &>
+
+<% $action->form_value('username') %>
+
+</&>
+<%args>
+$user
+$action
+</%args>

Added: CASPlus/trunk/share/web/templates/validate
==============================================================================
--- (empty file)
+++ CASPlus/trunk/share/web/templates/validate	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,10 @@
+<% $result->success ? 'yes' : 'no' %>
+% if ($result->success) {
+<% $result->content('username') %>
+% }
+<%args>
+$result
+</%args>
+<%init>
+$r->content_type('text/plain');
+</%init>

Added: CASPlus/trunk/t/00-dependencies.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/00-dependencies.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,12 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Test::More skip_all => 'Test::Dependencies does not work with Jifty.';
+
+SKIP: {
+    eval 'use Test::Dependencies plan => 1';
+    skip 'Test::Dependencies is not available.', 1 if $@;
+
+    ok_dependencies();
+};

Added: CASPlus/trunk/t/10-model-LoginAttempt.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/10-model-LoginAttempt.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,50 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A basic test harness for the LoginAttempt model.
+
+=cut
+
+use Jifty::Test tests => 11;
+
+# Make sure we can load the model
+use_ok('CASPlus::Model::LoginAttempt');
+
+# Grab a system user
+my $system_user = CASPlus::CurrentUser->superuser;
+ok($system_user, "Found a system user");
+
+# Try testing a create
+my $o = CASPlus::Model::LoginAttempt->new(current_user => $system_user);
+my ($id) = $o->create();
+ok($id, "LoginAttempt create returned success");
+ok($o->id, "New LoginAttempt has valid id set");
+is($o->id, $id, "Create returned the right id");
+
+# And another
+$o->create();
+ok($o->id, "LoginAttempt create returned another value");
+isnt($o->id, $id, "And it is different from the previous one");
+
+# Searches in general
+my $collection =  CASPlus::Model::LoginAttemptCollection->new(
+    current_user => $system_user);
+$collection->unlimit;
+is($collection->count, 2, "Finds two records");
+
+# Searches in specific
+$collection->limit(column => 'id', value => $o->id);
+is($collection->count, 1, "Finds one record with specific id");
+
+# Delete one of them
+$o->delete;
+$collection->redo_search;
+is($collection->count, 0, "Deleted row is gone");
+
+# And the other one is still there
+$collection->unlimit;
+is($collection->count, 1, "Still one left");
+

Added: CASPlus/trunk/t/10-model-Profile.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/10-model-Profile.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,63 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A basic test harness for the Profile model.
+
+=cut
+
+use Jifty::Test tests => 17;
+
+# Make sure we can load the model
+use_ok('CASPlus::Model::Profile');
+
+# Grab a system user
+my $system_user = CASPlus::CurrentUser->superuser;
+ok($system_user, "Found a system user");
+
+# Try testing a create
+my $o = CASPlus::Model::Profile->new(current_user => $system_user);
+my ($id) = $o->create(
+    name         => 'Some Association Member',
+    profile_type => 'user',
+);
+ok($id, "Profile create returned success");
+ok($o->id, "New Profile has valid id set");
+is($o->id, $id, "Create returned the right id");
+
+ok($o->model_class, 'Profile has a model_class');
+isa_ok($o->model_class, 'Jifty::Model::ModelClass', 'model_class isa ModelClass');
+is($o->model_class->name, 'SomeAssociationMember', 'model_class is named SomeAssociationMember');
+
+# And another
+$o->create(
+    name         => 'some association role-thingy-whatsit',
+    profile_type => 'role',
+);
+ok($o->id, "Profile create returned another value");
+isnt($o->id, $id, "And it is different from the previous one");
+
+ok($o->model_class, 'Profile has a model_class');
+isa_ok($o->model_class, 'Jifty::Model::ModelClass', 'model_class isa ModelClass');
+is($o->model_class->name, 'SomeAssociationRoleThingyWhatsit', 'model_class is named SomeAssociationRoleThingyWhatsit');
+
+# Searches in general
+my $collection =  CASPlus::Model::ProfileCollection->new(current_user => $system_user);
+$collection->unlimit;
+is($collection->count, 2, "Finds two records");
+
+# Searches in specific
+$collection->limit(column => 'id', value => $o->id);
+is($collection->count, 1, "Finds one record with specific id");
+
+# Delete one of them
+$o->delete;
+$collection->redo_search;
+is($collection->count, 0, "Deleted row is gone");
+
+# And the other one is still there
+$collection->unlimit;
+is($collection->count, 1, "Still one left");
+

Added: CASPlus/trunk/t/10-model-ProfileProperty.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/10-model-ProfileProperty.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,62 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A basic test harness for the ProfileProperty model.
+
+=cut
+
+use Jifty::Test tests => 12;
+
+# Make sure we can load the model
+use_ok('CASPlus::Model::ProfileProperty');
+
+# Grab a system user
+my $system_user = CASPlus::CurrentUser->superuser;
+ok($system_user, "Found a system user");
+
+my $profile = CASPlus::Model::Profile->new(current_user => $system_user);
+$profile->create(
+    name         => 'Foo User',
+    profile_type => 'user',
+);
+ok($profile->id, 'got a profile');
+
+# Try testing a create
+my $o = CASPlus::Model::ProfileProperty->new(current_user => $system_user);
+my ($id) = $o->create(
+    name    => 'First name',
+    profile => $profile,
+);
+ok($id, "ProfileProperty create returned success");
+ok($o->id, "New ProfileProperty has valid id set");
+is($o->id, $id, "Create returned the right id");
+
+# And another
+$o->create(
+    name    => 'Last name',
+    profile => $profile,
+);
+ok($o->id, "ProfileProperty create returned another value");
+isnt($o->id, $id, "And it is different from the previous one");
+
+# Searches in general
+my $collection =  CASPlus::Model::ProfilePropertyCollection->new(current_user => $system_user);
+$collection->unlimit;
+is($collection->count, 2, "Finds two records");
+
+# Searches in specific
+$collection->limit(column => 'id', value => $o->id);
+is($collection->count, 1, "Finds one record with specific id");
+
+# Delete one of them
+$o->delete;
+$collection->redo_search;
+is($collection->count, 0, "Deleted row is gone");
+
+# And the other one is still there
+$collection->unlimit;
+is($collection->count, 1, "Still one left");
+

Added: CASPlus/trunk/t/10-model-ProxyGrantSession.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/10-model-ProxyGrantSession.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,70 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A basic test harness for the ProxyGrantSession model.
+
+=cut
+
+use Jifty::Test tests => 14;
+
+# Make sure we can load the model
+use_ok('CASPlus::Model::ProxyGrantSession');
+
+# Grab a system user
+my $system_user = CASPlus::CurrentUser->superuser;
+ok($system_user, "Found a system user");
+
+# Create a generic user
+my $user = CASPlus::Model::User->new(current_user => $system_user);
+$user->create( username => 'test-ProxyGrantSession', password => 'test' );
+ok($user, 'Created a generic user');
+
+# Create a generic ticket granting cookie
+my $sso_session = CASPlus::Model::SSOSession->new(current_user => $system_user);
+$sso_session->create( authenticated_user => $user );
+ok($sso_session, 'Created a ticket granting cookie');
+
+# Create a generic service ticket
+my $service_session = CASPlus::Model::ServiceSession->new(current_user => $system_user);
+$service_session->create( sso_session => $sso_session, service_url => 'http://localhost:1234' );
+ok($service_session, 'Created a service ticket');
+
+# Try testing a create
+my $o = CASPlus::Model::ProxyGrantSession->new(current_user => $system_user);
+my ($id) = $o->create(
+    service_session => $service_session,
+    callback_url    => 'http://localhost:1234/pgtUrl',
+);
+ok($id, "ProxyGrantSession create returned success");
+ok($o->id, "New ProxyGrantSession has valid id set");
+is($o->id, $id, "Create returned the right id");
+
+# And another
+$o->create(
+    service_session => $service_session,
+    callback_url    => 'http://localhost:1234/pgtUrl2',
+);
+ok($o->id, "ProxyGrantSession create returned another value");
+isnt($o->id, $id, "And it is different from the previous one");
+
+# Searches in general
+my $collection =  CASPlus::Model::ProxyGrantSessionCollection->new(current_user => $system_user);
+$collection->unlimit;
+is($collection->count, 2, "Finds two records");
+
+# Searches in specific
+$collection->limit(column => 'id', value => $o->id);
+is($collection->count, 1, "Finds one record with specific id");
+
+# Delete one of them
+$o->delete;
+$collection->redo_search;
+is($collection->count, 0, "Deleted row is gone");
+
+# And the other one is still there
+$collection->unlimit;
+is($collection->count, 1, "Still one left");
+

Added: CASPlus/trunk/t/10-model-ProxySession.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/10-model-ProxySession.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,75 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A basic test harness for the ProxySession model.
+
+=cut
+
+use Jifty::Test tests => 15;
+
+# Make sure we can load the model
+use_ok('CASPlus::Model::ProxySession');
+
+# Grab a system user
+my $system_user = CASPlus::CurrentUser->superuser;
+ok($system_user, "Found a system user");
+
+# Create a generic user
+my $user = CASPlus::Model::User->new(current_user => $system_user);
+$user->create( username => 'test-ProxySession', password => 'test' );
+ok($user, 'Created a generic user');
+
+# Create a generic ticket granting cookie
+my $sso_session = CASPlus::Model::SSOSession->new(current_user => $system_user);
+$sso_session->create( authenticated_user => $user );
+ok($sso_session, 'Created a ticket granting cookie');
+
+# Create a generic service ticket
+my $service_session = CASPlus::Model::ServiceSession->new(current_user => $system_user);
+$service_session->create( sso_session => $sso_session, service_url => 'http://localhost:1234' );
+ok($service_session, 'Created a service ticket');
+
+# Create a generic proxy granting ticket
+my $proxy_granting_session = CASPlus::Model::ProxyGrantSession->new(current => $system_user);
+$proxy_granting_session->create( service_session => $service_session, callback_url => 'http://localhost:1234/pgtUrl' );
+ok($proxy_granting_session, 'Created a proxy granting ticket');
+
+# Try testing a create
+my $o = CASPlus::Model::ProxySession->new(current_user => $system_user);
+my ($id) = $o->create(
+    proxy_grant_session => $proxy_granting_session,
+    service_identifier  => 'proxy-service-1',
+);
+ok($id, "ProxySession create returned success");
+ok($o->id, "New ProxySession has valid id set");
+is($o->id, $id, "Create returned the right id");
+
+# And another
+$o->create(
+    proxy_grant_session => $proxy_granting_session,
+    service_identifier  => 'proxy-service-2',
+);
+ok($o->id, "ProxySession create returned another value");
+isnt($o->id, $id, "And it is different from the previous one");
+
+# Searches in general
+my $collection =  CASPlus::Model::ProxySessionCollection->new(current_user => $system_user);
+$collection->unlimit;
+is($collection->count, 2, "Finds two records");
+
+# Searches in specific
+$collection->limit(column => 'id', value => $o->id);
+is($collection->count, 1, "Finds one record with specific id");
+
+# Delete one of them
+$o->delete;
+$collection->redo_search;
+is($collection->count, 0, "Deleted row is gone");
+
+# And the other one is still there
+$collection->unlimit;
+is($collection->count, 1, "Still one left");
+

Added: CASPlus/trunk/t/10-model-Role.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/10-model-Role.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,53 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A basic test harness for the Role model.
+
+=cut
+
+use Jifty::Test tests => 11;
+
+# Make sure we can load the model
+use_ok('CASPlus::Model::Role');
+
+# Grab a system user
+my $system_user = CASPlus::CurrentUser->superuser;
+ok($system_user, "Found a system user");
+
+# Try testing a create
+my $o = CASPlus::Model::Role->new(current_user => $system_user);
+my ($id) = $o->create(
+    name => 'foo',
+);
+ok($id, "Role create returned success");
+ok($o->id, "New Role has valid id set");
+is($o->id, $id, "Create returned the right id");
+
+# And another
+$o->create(
+    name => 'bar',
+);
+ok($o->id, "Role create returned another value");
+isnt($o->id, $id, "And it is different from the previous one");
+
+# Searches in general
+my $collection =  CASPlus::Model::RoleCollection->new(current_user => $system_user);
+$collection->unlimit;
+is($collection->count, 2, "Finds two records");
+
+# Searches in specific
+$collection->limit(column => 'id', value => $o->id);
+is($collection->count, 1, "Finds one record with specific id");
+
+# Delete one of them
+$o->delete;
+$collection->redo_search;
+is($collection->count, 0, "Deleted row is gone");
+
+# And the other one is still there
+$collection->unlimit;
+is($collection->count, 1, "Still one left");
+

Added: CASPlus/trunk/t/10-model-RoleMember.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/10-model-RoleMember.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,64 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A basic test harness for the RoleMember model.
+
+=cut
+
+use Jifty::Test tests => 14;
+
+# Make sure we can load the model
+use_ok('CASPlus::Model::RoleMember');
+
+# Grab a system user
+my $system_user = CASPlus::CurrentUser->superuser;
+ok($system_user, "Found a system user");
+
+# Create a test user
+my $user = CASPlus::Model::User->new;
+$user->create( username => 'test' );
+ok($user->id, 'created a test user');
+
+# Create a test role
+my $role1 = CASPlus::Model::Role->new;
+$role1->create( name => 'role1' );
+ok($role1->id, 'created a test role');
+
+# Create a test role
+my $role2 = CASPlus::Model::Role->new;
+$role2->create( name => 'role2' );
+ok($role2->id, 'created another test role');
+
+# Try testing a create
+my $o = CASPlus::Model::RoleMember->new(current_user => $system_user);
+my ($id) = $o->create( the_user => $user, the_role => $role1 );
+ok($id, "RoleMember create returned success");
+ok($o->id, "New RoleMember has valid id set");
+is($o->id, $id, "Create returned the right id");
+
+# And another
+$o->create( the_user => $user, the_role => $role2 );
+ok($o->id, "RoleMember create returned another value");
+isnt($o->id, $id, "And it is different from the previous one");
+
+# Searches in general
+my $collection =  CASPlus::Model::RoleMemberCollection->new(current_user => $system_user);
+$collection->unlimit;
+is($collection->count, 2, "Finds two records");
+
+# Searches in specific
+$collection->limit(column => 'id', value => $o->id);
+is($collection->count, 1, "Finds one record with specific id");
+
+# Delete one of them
+$o->delete;
+$collection->redo_search;
+is($collection->count, 0, "Deleted row is gone");
+
+# And the other one is still there
+$collection->unlimit;
+is($collection->count, 1, "Still one left");
+

Added: CASPlus/trunk/t/10-model-SSOSession.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/10-model-SSOSession.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,57 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A basic test harness for the SSOSession model.
+
+=cut
+
+use Jifty::Test tests => 12;
+
+# Make sure we can load the model
+use_ok('CASPlus::Model::SSOSession');
+
+# Grab a system user
+my $system_user = CASPlus::CurrentUser->superuser;
+ok($system_user, "Found a system user");
+
+# Need a user object first
+my $user = CASPlus::Model::User->new(current_user => $system_user);
+$user->create(
+    username => 'SSOSession-test',
+    password => 'test',
+);
+ok($user, 'Created a generic user.');
+
+# Try testing a create
+my $o = CASPlus::Model::SSOSession->new(current_user => $system_user);
+my ($id) = $o->create( authenticated_user => $user );
+ok($id, "SSOSession create returned success");
+ok($o->id, "New SSOSession has valid id set");
+is($o->id, $id, "Create returned the right id");
+
+# And another
+$o->create( authenticated_user => $user );
+ok($o->id, "SSOSession create returned another value");
+isnt($o->id, $id, "And it is different from the previous one");
+
+# Searches in general
+my $collection =  CASPlus::Model::SSOSessionCollection->new(current_user => $system_user);
+$collection->unlimit;
+is($collection->count, 2, "Finds two records");
+
+# Searches in specific
+$collection->limit(column => 'id', value => $o->id);
+is($collection->count, 1, "Finds one record with specific id");
+
+# Delete one of them
+$o->delete;
+$collection->redo_search;
+is($collection->count, 0, "Deleted row is gone");
+
+# And the other one is still there
+$collection->unlimit;
+is($collection->count, 1, "Still one left");
+

Added: CASPlus/trunk/t/10-model-ServiceSession.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/10-model-ServiceSession.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,66 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A basic test harness for the ServiceSession model.
+
+=cut
+
+use Jifty::Test tests => 13;
+
+# Make sure we can load the model
+use_ok('CASPlus::Model::ServiceSession');
+
+# Grab a system user
+my $system_user = CASPlus::CurrentUser->superuser;
+ok($system_user, "Found a system user");
+
+# Create a generic user
+my $user = CASPlus::Model::User->new(current_user => $system_user);
+$user->create( username => 'ServiceSession-test', password => 'test' );
+ok($user, 'Created a generic user');
+
+# Create a generic ticket granting cookie
+my $session = CASPlus::Model::SSOSession->new(current_user => $system_user);
+$session->create( authenticated_user => $user );
+ok($session, 'Created a ticket granting cookie');
+
+# Try testing a create
+my $o = CASPlus::Model::ServiceSession->new(current_user => $system_user);
+my ($id) = $o->create(
+    sso_session => $session,
+    service_url => 'http://localhost:1234/',
+);
+ok($id, "ServiceSession create returned success");
+ok($o->id, "New ServiceSession has valid id set");
+is($o->id, $id, "Create returned the right id");
+
+# And another
+$o->create(
+    sso_session => $session,
+    service_url => 'http://localhost:4321/',
+);
+ok($o->id, "ServiceSession create returned another value");
+isnt($o->id, $id, "And it is different from the previous one");
+
+# Searches in general
+my $collection =  CASPlus::Model::ServiceSessionCollection->new(
+    current_user => $system_user);
+$collection->unlimit;
+is($collection->count, 2, "Finds two records");
+
+# Searches in specific
+$collection->limit(column => 'id', value => $o->id);
+is($collection->count, 1, "Finds one record with specific id");
+
+# Delete one of them
+$o->delete;
+$collection->redo_search;
+is($collection->count, 0, "Deleted row is gone");
+
+# And the other one is still there
+$collection->unlimit;
+is($collection->count, 1, "Still one left");
+

Added: CASPlus/trunk/t/10-model-User.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/10-model-User.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,49 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A basic test harness for the User model.
+
+=cut
+
+use Jifty::Test tests => 11;
+
+# Make sure we can load the model
+use_ok('CASPlus::Model::User');
+
+# Grab a system user
+my $system_user = CASPlus::CurrentUser->superuser;
+ok($system_user, "Found a system user");
+
+# Try testing a create
+my $o = CASPlus::Model::User->new(current_user => $system_user);
+my ($id) = $o->create( username => 'User-test', password => 'test' );
+ok($id, "User create returned success");
+ok($o->id, "New User has valid id set");
+is($o->id, $id, "Create returned the right id");
+
+# And another
+$o->create( username => 'User2-test', password => 'test' );
+ok($o->id, "User create returned another value");
+isnt($o->id, $id, "And it is different from the previous one");
+
+# Searches in general
+my $collection =  CASPlus::Model::UserCollection->new(current_user => $system_user);
+$collection->unlimit;
+is($collection->count, 2, "Finds two records");
+
+# Searches in specific
+$collection->limit(column => 'id', value => $o->id);
+is($collection->count, 1, "Finds one record with specific id");
+
+# Delete one of them
+$o->delete;
+$collection->redo_search;
+is($collection->count, 0, "Deleted row is gone");
+
+# And the other one is still there
+$collection->unlimit;
+is($collection->count, 1, "Still one left");
+

Added: CASPlus/trunk/t/20-action-Login.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/20-action-Login.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A (very) basic test harness for the Login action.
+
+=cut
+
+use Jifty::Test tests => 5;
+
+# Make sure we can load the action
+use_ok('CASPlus::Action::Login');
+
+my $user = CASPlus::Model::User->new;
+$user->create( username => 'test-Login', password => 'test' );
+ok($user, 'created a test user');
+
+my $login_ticket = CASPlus::Model::LoginAttempt->new_ticket;
+ok($login_ticket, 'created a login ticket');
+
+Jifty::Test->web;
+my $login = Jifty->web->new_action(
+    class     => 'Login',
+    arguments => {
+        username => 'test-Login',
+        password => 'test',
+        lt       => $login_ticket->login_ticket,
+    },
+);
+ok($login, 'created login action');
+
+$login->run;
+ok($login->result->success, 'successful login');

Added: CASPlus/trunk/t/20-action-LoginCheck.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/20-action-LoginCheck.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A (very) basic test harness for the LoginCheck action.
+
+=cut
+
+use Jifty::Test tests => 1;
+
+# Make sure we can load the action
+use_ok('CASPlus::Action::LoginCheck');
+

Added: CASPlus/trunk/t/20-action-Logout.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/20-action-Logout.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A (very) basic test harness for the Logout action.
+
+=cut
+
+use Jifty::Test tests => 1;
+
+# Make sure we can load the action
+use_ok('CASPlus::Action::Logout');
+

Added: CASPlus/trunk/t/20-action-Proxy.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/20-action-Proxy.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A (very) basic test harness for the Proxy action.
+
+=cut
+
+use Jifty::Test tests => 1;
+
+# Make sure we can load the action
+use_ok('CASPlus::Action::Proxy');
+

Added: CASPlus/trunk/t/20-action-ProxyValidate.pm
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/20-action-ProxyValidate.pm	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A (very) basic test harness for the ProxyValidate action.
+
+=cut
+
+use Jifty::Test tests => 1;
+
+# Make sure we can load the action
+use_ok('CASPlus::Action::ProxyValidate');
+

Added: CASPlus/trunk/t/20-action-Validate.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/20-action-Validate.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A (very) basic test harness for the Validate action.
+
+=cut
+
+use Jifty::Test tests => 1;
+
+# Make sure we can load the action
+use_ok('CASPlus::Action::Validate');
+

Added: CASPlus/trunk/t/40-tickets.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/40-tickets.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Jifty::Test tests => 47;
+use Readonly;
+
+use_ok('CASPlus::Util');
+
+Readonly my @letters => (
+    'A' .. 'Z', 'a' .. 'z', '0' .. '9', '-'
+);
+ Readonly my $letters_match => qr/[ A-Z a-z 0-9 \- ]+/x;
+
+for my $ticket (qw/ ST PGT PGTIOU LT TGC /) {
+    my $config = Jifty->config->app('Tickets')->{ $ticket };
+
+    my $expected_expiration_time 
+        = $ticket eq 'ST'       ? { minutes => 5 }
+        : $ticket eq 'PT'       ? { minutes => 5 }
+        : $ticket eq 'TGC'      ? 'forever'
+        :                         undef;
+
+    if (defined $expected_expiration_time) {
+        ok($config->{ExpirationTime}, "$ticket expiration time is set");
+        is_deeply($config->{ExpirationTime}, $expected_expiration_time,
+            "$ticket expiration time set correctly");
+
+        my $now = DateTime->now;
+        my $expiration_time = CASPlus::Util->expiration_time($ticket);
+
+        if ($expected_expiration_time eq 'forever') {
+            is($expiration_time, undef, 
+                "$ticket generated expiration is correct");
+        }
+
+        else {
+            my $then  = $now->clone->add( minutes => 5 );
+            my $least = $then->clone->subtract( seconds => 10 );
+            my $most  = $then->clone->add( seconds => 10 );
+
+            ok($least <= $expiration_time && $expiration_time <= $most, 
+                "$ticket generated expiration is about were expected")
+                or diag(
+                     "\tgot:                $expiration_time\n"
+                    ."\tlatest expected:    $least\n"
+                    ."\tearliest expected:  $most");
+        }
+    }
+
+    ok($config->{Format}, "$ticket format is set");
+    is($config->{Format}, '%p-', "$ticket format is set correctly");
+
+    my $expected_length
+        = $ticket eq 'TGC' ? 64
+        : $ticket eq 'PGT' ? 64
+        :                    32;
+
+    ok($config->{Length}, "$ticket length is set");
+    is($config->{Length}, $expected_length, "$ticket length is set correctly");
+
+    ok($config->{Letters}, "$ticket letters is set");
+    is_deeply($config->{Letters}, \@letters, 
+        "$ticket letters is set correctly");
+
+    my $identifier = CASPlus::Util->generate_ticket($ticket);
+    is(length($identifier), $expected_length, 
+        "$ticket identifier is the correct length");
+    like($identifier, qr/^$ticket-$letters_match$/,
+        "$ticket identifier is the correct format");
+}

Added: CASPlus/trunk/t/50-me.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/50-me.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,82 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Jifty::Test tests => 24;
+use Jifty::Test::WWW::Mechanize;
+
+my $system_user = CASPlus::CurrentUser->superuser;
+ok($system_user, 'got a system user');
+
+my $profile = CASPlus::Model::Profile->new(current_user => $system_user);
+$profile->create( name => 'Person', profile_type => 'user' );
+ok($profile->id, 'got a profile');
+
+my $property = CASPlus::Model::ProfileProperty->new(current_user => $system_user);
+$property->create( profile => $profile, name => 'Full name' );
+ok($property->id, 'got a property');
+
+my $user = CASPlus::Model::User->new(current_user => $system_user);
+$user->create( username => 'test-me', password => 'test' );
+ok($user->id, 'created a test user');
+
+my $user_profile = $profile->model_class->qualified_class->new(current_user => $system_user);
+isa_ok($user_profile, 'CASPlus::ProfileBase');
+can_ok($user_profile, 'user_object');
+can_ok($user_profile, 'full_name');
+$user_profile->create( user_object => $user, full_name => 'Unit Test' );
+ok($user_profile->id, 'created a user profile');
+
+my $server = Jifty::Test->make_server;
+my $mech = Jifty::Test::WWW::Mechanize->new;
+
+my $url = $server->started_ok;
+
+$mech->get_ok("$url/login", 'login page');
+$mech->set_visible('test-me', 'test');
+$mech->submit;
+
+$mech->title_is('Login Status', 'attempted login');
+$mech->content_contains('test-me', 'login success');
+
+# XXX Use instead of follow_link_ok because Jifty::Test::WWW::Mechanize applies
+# HTML::Lint, which pukes on the RDF.
+my $response = $mech->follow_link(text => 'test-me');
+ok($response->is_success, 'go to me');
+
+$mech->title_is(q{test-me's Profile}, 'test-me profile page');
+
+SKIP: {
+    eval "use Test::XML::XPath";
+    skip "Test::XML::XPath is not available.", 7 if $@;
+
+    my $xml = $mech->content;
+    my $xp  = XML::XPath->new($xml);
+
+    like_xpath($xml, '//rdf:RDF', 'has RDF element');
+    like_xpath($xml, '//rdf:RDF/casplus:user', 'has user element');
+
+    my $rdf_ns = $xp->findnodes('//rdf:RDF')->shift
+        ->getNamespace('rdf')->getExpanded;
+    my $casplus_ns = $xp->findnodes('//rdf:RDF/casplus:user')->shift
+        ->getNamespace('casplus')->getExpanded;
+
+    is($rdf_ns, 'http://www.w3.org/1999/02/22-rdf-syntax-ns#', 'rdf namespace');
+    is($casplus_ns, 'http://sterling.hanenkamp.com/rdf/CASPlus#', 
+        'casplus namespace');
+
+    my $user_id = $user->id;
+    like_xpath($xml, "//rdf:RDF/casplus:user[\@rdf:about='$url/user/$user_id']",
+        'rdf:about is set correctly');
+    like_xpath($xml, '//rdf:RDF/casplus:user/casplus:username', 
+        'username namespace');
+    is_xpath($xml, '//rdf:RDF/casplus:user/casplus:username', 'test-me',
+        'username is set correctly');
+
+    like_xpath($xml, '//rdf:RDF/casplus:user/casplus:profile',
+        'user has a profile');
+    like_xpath($xml, '//rdf:RDF/casplus:user/casplus:profile/casplus:full_name',
+        'user has a full name');
+    is_xpath($xml, '//rdf:RDF/casplus:user/casplus:profile/casplus:full_name',
+        'Unit Test', 'full name is set correctly');
+};

Added: CASPlus/trunk/t/50-root-redirect.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/50-root-redirect.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+use Jifty::Test tests => 4;
+use Jifty::Test::WWW::Mechanize;
+
+my $server = Jifty::Test->make_server;
+isa_ok($server, 'Jifty::Server');
+my $cas_url = $server->started_ok;
+
+my $mech = Jifty::Test::WWW::Mechanize->new;
+
+$mech->get_ok("$cas_url/", 'Fetched the root page.');
+is($mech->uri, "$cas_url/login", '/ redirects to /login');

Added: CASPlus/trunk/t/99-CAS-protocol.t
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/99-CAS-protocol.t	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,248 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+use Jifty::Test tests => 79;
+use Jifty::Test::WWW::Mechanize;
+require 't/util.pl';
+
+use_ok('CASPlus::Model::User');
+
+my $system_user = CASPlus::CurrentUser->superuser;
+ok($system_user, 'Found a system user.');
+
+my $user = CASPlus::Model::User->new(current_user => $system_user);
+$user->create( username => 'test-AuthCAS', password => 'test' );
+ok($user->id, 'Created a test user.');
+
+my $server = Jifty::Test->make_server;
+my $cas_url = $server->started_ok;
+
+my $cas_port = Jifty->config->framework('Web')->{'Port'};
+my $service_port = $cas_port + 1;
+
+my $service_url = start_test_service($service_port);
+ok($service_url, 'started the test service');
+
+my $mech = Jifty::Test::WWW::Mechanize->new;
+ok($mech, 'got a mechanize object');
+
+$mech->get_ok("$cas_url/login", 'Fetched the login form.');
+
+$mech->set_visible( 'test-AuthCAS', 'test' );
+$mech->submit;
+
+$mech->title_is('Login Status', 'Attempted login.');
+$mech->content_contains('You are currently signed in', 'Login Status page');
+$mech->content_contains('test-AuthCAS', 'Login Status page');
+
+$mech->get("$cas_url/login?service=$service_url");
+my %query = $mech->uri->query_form;
+like($query{ticket}, qr/^ST-[0-9A-Za-z-]+/, 'Got a service ticket');
+
+$mech->get_ok("$cas_url/validate?service=$service_url&ticket=$query{ticket}", 
+    'CAS 1.0 validation');
+$mech->content_is("yes\ntest-AuthCAS\n", 'CAS 1.0 validation success');
+
+$mech->get_ok("$cas_url/logout", 'logging out');
+$mech->title_is('Logged out', 'log out page');
+$mech->content_contains('You are now logged out.', 'log out success');
+
+# Login again and get a ticket during login this time
+$mech->get_ok("$cas_url/login?service=$service_url", 'fresh login');
+
+$mech->set_visible( 'test-AuthCAS', 'test' );
+$mech->submit;
+
+%query = $mech->uri->query_form;
+like($query{ticket}, qr/^ST-[0-9A-Za-z-]+/, 'get another service ticket');
+
+$mech->get_ok("$cas_url/serviceValidate?service=$service_url&ticket=$query{ticket}",
+    'CAS 2.0 validation');
+
+SKIP: {
+    eval "use Test::XML::XPath";
+    skip "Test::XML::XPath is not available.", 5 if $@;
+
+    my $xml = $mech->content;
+    my $xp = XML::XPath->new($xml);
+
+    like_xpath($xml, '/cas:serviceResponse', 'validation root');
+    
+    my $ns = $xp->findnodes('/cas:serviceResponse')->shift
+        ->getNamespace('cas')->getExpanded;
+    is($ns, 'http://www.yale.edu/tp/cas', 'validation namespace');
+
+    like_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess', 'validation success');
+    like_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:user', 'validation user node exists');
+    is_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:user', 'test-AuthCAS', 'validation user correct');
+};
+
+
+$mech->get_ok("$cas_url/logout", 'logging out again');
+$mech->title_is('Logged out', 'log out page again');
+$mech->content_contains('You are now logged out.', 'log out success again');
+
+# Login again and get a ticket and a proxy granting IOU
+$mech->get_ok("$cas_url/login?service=$service_url", 'fresh login again');
+
+$mech->set_visible( 'test-AuthCAS', 'test' );
+$mech->submit;
+
+%query = $mech->uri->query_form;
+like($query{ticket}, qr/^ST-[0-9A-Za-z-]+/, 'get yet another service ticket');
+
+$mech->get_ok("$cas_url/serviceValidate?service=$service_url&ticket=$query{ticket}&pgtUrl=$service_url/pgtUrl/1",
+    'CAS 2.0 validation with pgtUrl');
+
+my $iou;
+SKIP: {
+    eval "use Test::XML::XPath";
+    skip "Test::XML::XPath is not available.", 9 if $@;
+
+    my $xml = $mech->content;
+    my $xp = XML::XPath->new($xml);
+
+    like_xpath($xml, '/cas:serviceResponse', 'validation root');
+    
+    my $ns = $xp->findnodes('/cas:serviceResponse')->shift
+        ->getNamespace('cas')->getExpanded;
+    is($ns, 'http://www.yale.edu/tp/cas', 'validation namespace');
+
+    like_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess', 'validation success');
+    like_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:user', 'validation user node exists');
+    is_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:user', 'test-AuthCAS', 'validation user correct');
+    like_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:proxyGrantingTicket', 'we have a proxy granting ticket');
+
+    $iou = $xp->findvalue('/cas:serviceResponse/cas:authenticationSuccess/cas:proxyGrantingTicket');
+    like($iou, qr/^PGTIOU-/, 'proxy granting ticket format');
+
+    $mech->get_ok("$service_url/getIOU/1", 'ask service for the IOU it was given');
+    $mech->content_is($iou, 'IOU sent to service matches IOU returned');
+};
+
+$mech->get_ok("$service_url/getPGT/1", 'ask service for the PGT it was given');
+$mech->content_like(qr/^PGT-/, 'PGT is in the correct format');
+my $pgt = $mech->content;
+
+$mech->get_ok("$cas_url/proxy?pgt=$pgt&targetService=backend-service", 'fetching a proxy ticket');
+
+my $proxy_ticket;
+SKIP: {
+    eval "use Test::XML::XPath";
+    skip "Test::XML::XPath is not available.", 5 if $@;
+
+    my $xml = $mech->content;
+    my $xp = XML::XPath->new($xml);
+
+    like_xpath($xml, '/cas:serviceResponse', 'proxy root');
+    
+    my $ns = $xp->findnodes('/cas:serviceResponse')->shift
+        ->getNamespace('cas')->getExpanded;
+    is($ns, 'http://www.yale.edu/tp/cas', 'proxy namespace');
+
+    like_xpath($xml, '/cas:serviceResponse/cas:proxySuccess', 'proxy success');
+    like_xpath($xml, '/cas:serviceResponse/cas:proxySuccess/cas:proxyTicket', 'got a proxy ticket');
+
+    $proxy_ticket = $xp->findvalue('/cas:serviceResponse/cas:proxySuccess/cas:proxyTicket');
+    like($proxy_ticket, qr/^PT-/, 'proxy ticket format');
+};
+
+if (!defined $proxy_ticket) {
+    ($proxy_ticket) = $mech->content =~ m{<cas:proxyTicket>([A-Za-z0-9-]*)</cas:proxyTicket>};
+}
+
+$mech->get_ok("$cas_url/proxyValidate?service=backend-service&ticket=$proxy_ticket&pgtUrl=$service_url/pgtUrl/2", 'proxy ticket validation');
+
+SKIP: {
+    eval "use Test::XML::XPath";
+    skip "Test::XML::XPath is not available.", 12 if $@;
+
+    my $xml = $mech->content;
+    my $xp = XML::XPath->new($xml);
+
+    like_xpath($xml, '/cas:serviceResponse', 'proxy validation root');
+    
+    my $ns = $xp->findnodes('/cas:serviceResponse')->shift
+        ->getNamespace('cas')->getExpanded;
+    is($ns, 'http://www.yale.edu/tp/cas', 'proxy validation namespace');
+
+    like_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess', 'proxy validation success');
+    like_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:user', 'proxy validation user node exists');
+    is_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:user', 'test-AuthCAS', 'proxy validation user correct');
+
+    like_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:proxyGrantingTicket');
+
+    $iou = $xp->findvalue('/cas:serviceResponse/cas:authenticationSuccess/cas:proxyGrantingTicket');
+    like($iou, qr/^PGTIOU-/, 'proxy granting ticket format');
+
+    like_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:proxies', 'proxy list node');
+    like_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:proxies/cas:proxy', 'proxy url node');
+    is_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:proxies/cas:proxy', "$service_url/pgtUrl/1", 'proxy url matches');
+
+    $mech->get_ok("$service_url/getIOU/2", 'ask service for the IOU it was given');
+    $mech->content_is($iou, 'IOU sent to service matches IOU returned');
+};
+
+
+$mech->get_ok("$service_url/getPGT/2", 'ask service for the PGT it was given');
+$mech->content_like(qr/^PGT-/, 'PGT is in the correct format');
+$pgt = $mech->content;
+
+$mech->get_ok("$cas_url/proxy?pgt=$pgt&targetService=backend-service", 'fetching a proxy ticket');
+
+undef $proxy_ticket;
+SKIP: {
+    eval "use Test::XML::XPath";
+    skip "Test::XML::XPath is not available.", 5 if $@;
+
+    my $xml = $mech->content;
+    my $xp = XML::XPath->new($xml);
+
+    like_xpath($xml, '/cas:serviceResponse', 'proxy root');
+    
+    my $ns = $xp->findnodes('/cas:serviceResponse')->shift
+        ->getNamespace('cas')->getExpanded;
+    is($ns, 'http://www.yale.edu/tp/cas', 'proxy namespace');
+
+    like_xpath($xml, '/cas:serviceResponse/cas:proxySuccess', 'proxy success');
+    like_xpath($xml, '/cas:serviceResponse/cas:proxySuccess/cas:proxyTicket', 'got a proxy ticket');
+
+    $proxy_ticket = $xp->findvalue('/cas:serviceResponse/cas:proxySuccess/cas:proxyTicket');
+    like($proxy_ticket, qr/^PT-/, 'proxy ticket format');
+};
+
+if (!defined $proxy_ticket) {
+    ($proxy_ticket) = $mech->content =~ m{<cas:proxyTicket>([A-Za-z0-9-]*)</cas:proxyTicket>};
+}
+
+$mech->get_ok("$cas_url/proxyValidate?service=backend-service&ticket=$proxy_ticket", 'proxy ticket validation');
+
+SKIP: {
+    eval "use Test::XML::XPath";
+    skip "Test::XML::XPath is not available.", 10 if $@;
+
+    my $xml = $mech->content;
+    my $xp = XML::XPath->new($xml);
+
+    like_xpath($xml, '/cas:serviceResponse', 'proxy validation root');
+    
+    my $ns = $xp->findnodes('/cas:serviceResponse')->shift
+        ->getNamespace('cas')->getExpanded;
+    is($ns, 'http://www.yale.edu/tp/cas', 'proxy validation namespace');
+
+    like_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess', 'proxy validation success');
+    like_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:user', 'proxy validation user node exists');
+    is_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:user', 'test-AuthCAS', 'proxy validation user correct');
+
+    like_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:proxies', 'proxy list node');
+    like_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:proxies/cas:proxy[1]', 'first proxy url node');
+    like_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:proxies/cas:proxy[2]', 'second proxy url node');
+
+    # Most recent must be first
+    is_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:proxies/cas:proxy[1]', "$service_url/pgtUrl/2", 'proxy url matches');
+    is_xpath($xml, '/cas:serviceResponse/cas:authenticationSuccess/cas:proxies/cas:proxy[2]', "$service_url/pgtUrl/1", 'proxy url matches');
+};
+
+
+stop_test_services();

Added: CASPlus/trunk/t/test-service.pl
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/test-service.pl	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,39 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+package CASPlus::TestService;
+use base qw/ HTTP::Server::Simple::CGI /;
+
+sub handle_request {
+    my ($self, $cgi) = @_;
+
+    print "HTTP/1.0 200 OK\n";
+    print $cgi->header( -type => 'text/plain' );
+
+    if ($cgi->path_info =~ m{^/pgtUrl/(.+)}) {
+        $self->{cas_proxy_request}{$1} = $cgi->Vars;
+    }
+
+    if ($cgi->path_info =~ m{^/getIOU/(.+)}) {
+        print $self->{cas_proxy_request}{$1}{pgtIou};
+    }
+
+    elsif ($cgi->path_info =~ m{^/getPGT/(.+)}) {
+        print $self->{cas_proxy_request}{$1}{pgt};
+    }
+
+    else {
+        print "success\n";
+    }
+}
+
+package main;
+
+my $port = $ARGV[0];
+
+$SIG{TERM} = sub { exit };
+
+my $server = CASPlus::TestService->new;
+$server->port($port);
+$server->run;

Added: CASPlus/trunk/t/util.pl
==============================================================================
--- (empty file)
+++ CASPlus/trunk/t/util.pl	Fri Mar 16 16:35:35 2007
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use POSIX ":sys_wait_h";
+
+my @test_service_pids;
+
+sub start_test_service {
+    my ($port) = shift || int(10_000 + rand(5_000));
+
+    if (my $pid = fork) {
+        push @test_service_pids, $pid;
+    }
+
+    else {
+        close STDIN;
+        close STDOUT;
+        close STDERR;
+        exec 'perl', 't/test-service.pl', $port;
+    }
+
+    return "http://localhost:$port";
+}
+
+sub stop_test_services {
+    while (my $pid = shift @test_service_pids) {
+        kill TERM => $pid;
+        waitpid($pid, 0);
+    }
+}
+
+1


More information about the Jifty-commit mailing list