App-Dochazka-REST
view release on metacpan or search on metacpan
0.084 2014-07-22 14:32 CEST
- bin/dochazka-rest: rework into standalone server startup script
- t/301-psgi.t: start testing web server functionality
- REST.pm: add POD re: starting server and authentication, include PSGI
$app coderef in $REST singleton
- config/Dochazka_Config.pm, Resource.pm: add DOCHAZKA_REST_HTML param
defining the HTML displayed when someone accesses the server from a
browser
- Resource.pm: enable HTTP Basic Authorization for authentication, using a
hard-coded dummy username/password pair for now
- Build.PL, t/000-dependencies.t: update dependencies
0.085 2014-07-23 09:12 CEST
- t/000-depends.t: fix bug (wrong number of tests)
- dispatch_Message_en.conf: new file for path dispatch messages
- Dispatch.pm: work on '_get_response'
- Resource.pm: use 'expurgate' method (new in App::CELL::Status 0.194)
- t/301-dispatch.t: rename from 301-psgi.t and add unit tests
0.086 2014-07-23 09:40 CEST
0.159 2014-08-14 14:55 CEST
- config/REST_Config.pm: add DOCHAZKA_HOST and DOCHAZKA_PORT
- bin/dochazka-rest: look into how we could allow admin to specify host/port on
command line, yet default to values in site configuration if they are not
specified there
0.160 2014-08-16 10:17 CEST
- bin/dochazka-rest: comment out 'die' statement so server runs again
0.161 2014-08-18 10:38 CEST
- fix bug: "LDAP users can log in with wrong/no password"
0.162 2014-08-21 15:31 CEST
- t/002-root.t: fix broken unit test
- bin/dochazka-rest: turn on debug_mode
- Resource.pm: uncomment session ID debug message in _validate_session
0.163 2014-08-27 17:42 CEST
- Dispatch/Employee.pm->_put_employee: allow undef as value for optional fields
('fullname', 'email', 'passhash', 'salt', 'remark')
- Model/Employee.pm->expurgate: when expurgating employee objects, do not
0.277 2014-11-13 16:30 CET
- Dispatch/Schedule.pm: cleanup
- t/dispatch/schedule.t: add negative tests for 'schedule/eid/:eid/?:ts'
0.278 2014-11-13 22:32 CET
- t/dispatch/schedule.t: add more negative tests
- ../development-checklist, Docs/Workflow.pm: start blocking in interval
and lock resources; add verbiage
- config/dispatch/: make 'employee/self' be a synonym for 'employee/current'
and enable POST requests on these resources so employees can, e.g., change
their own password; update documentation of history resources
- REST_Config.pm: add 'DOCHAZKA_PROFILE_EDITABLE_FIELDS' for POST requests
on 'employee/self'
- t/dispatch/employee.t: run all 'employee/current' tests on 'employee/self'
as well; realize that if a resource returns 405 it will do so regardless
of which user we authenticate as (even non-existent user)
0.279 2014-11-14 10:39 CET
- Dispatch/Employee.pm: add _post_current (dispatch target for POST
'employee/{current, self}'
- t/dispatch/employee.t: ACL checks are not working for resources with
- REST/Dispatch.pm: add missing 'use Try::Tiny'; add some debugging messages to
'_get_dbstatus'; numify number of connections
- Test.pm: add some error checking;
- t/dispatch/top.t: add subtest for 'dbstatus' resource
0.345 2014-12-11 11:35 CET
- REST.pm: add verbiage to POD
- Resource.pm, Dispatch/Employee.pm: prepare for Blowfish
0.346 2014-12-11 18:36 CET
- hash passwords using Authen::Passphrase::SaltedDigest
- App::Dochazka::CLI authentication works fine
- tests in t/dispatch/ are broken
- Dispatch/Employee.pm: implement 'hash_the_password' routine, call it from
_insert_employee and _update_employee; export it for use in Test.pm
- Resource.pm: in _authenticate, compare password with stored salted hash
- Test.pm: import hash_the_password and use it in create_testing_employee;
adapt calls
- dbinit_Config.pm, t/sql/root.t: use the real hash+salt instead of the
plaintext password
0.347 2014-12-11 20:13 CET
- REST_Config.pm: modify DOCHAZKA_PROFILE_EDITABLE_FIELDS so inactives and
actives can still change their password now that we are hashing
- config/dispatch/employee_Config.pm: 'GET employee/nick/:nick' acl_profile was
set too restrictive - fix
- dbinit_Config.pm: use real hash/salt when INSERTing 'root' and 'demo'
employees
- Dispatch/Employee.pm: fix hash_the_password function calls
- Resource.pm: put call to Authen::Passphrase::SaltedDigest into a try/catch
block; add some basic error-checking
- t/: adapt to current state
0.348 2014-12-12 09:39 CET
- REST_Config.pm: add DOCHAZKA_AUDITING and DOCHAZKA_AUDIT_TABLES to (1) make
auditing optional, and (2) give site admin control over which tables are
audited
- REST.pm: make auditing optional; implement 'create_audit_triggers' and
'delete_audit_triggers' routines to enable auditing to be disabled and
- Dispatch/Shared.pm: migrate the not-very-aptly-named 'current' routine
- t/dispatch/{priv,schedule}.t: remove 'noop'/'help' tests
- t/dispatch/priv.t: unit runs cleanly
0.373 2015-02-06 15:23 CET
- migrate 'schedule/...' resources (WIP)
0.374 2015-02-08 19:49 CET
- Dispatch/Schedule.pm: migrate 'schedule/eid/...' and 'schedule/nick/...';
start migrating 'schedule/sid/:sid'
- Dispatch/Employee.pm: migrate 'employee/count/?:priv'; move hash_the_password
to Util.pm
- t/dispatch/schedule.t: migrate unit tests
0.375 2015-02-09 08:52 CET
- Dispatch/Shared.pm: make a generalized method ('handler_first_pass_lookup')
for fetching objects from the database based on URI mapping
- start migrating resource handlers to the new method
0.376 2015-02-09 15:15 CET
- migrating resources to 'handler_first_pass_lookup'
- sql: make schedhistory SELECTs return scode as well as SID
- tests: schedhistory SELECTs are now returning scode
0.550 2017-10-16 22:05 CEST
- build/ops: require App::Dochazka::Common 0.207
- Drastically reduce verbosity of DBI error messages...
- Model/Employee.pm: regex for non-whitespace instead of true/false
- Dispatch.pm: have session/terminate return a real status code
- tests: ldap.t: display value of DOCHAZKA_LDAP_SERVER config param
- config: tweak whitespace in Component_Config.pm
- Auth.pm: debug log message with LDAP password
- ResourceDefs: allow passerby to GET activities
- doc: ResourceDefs: clarify schedule property of employee/self/full
0.551 2017-10-20 15:29 CEST
- ResourceDefs: allow passerby to GET schedule/sid/:sid
0.552 2017-10-23 11:53 CEST
- ResourceDefs: fix permissions on schedule/eid/:eid/?:ts
- Fillup: produce 100% schedule fulfillment without clobbering
- Fillup: return just scheduled intervals if clobber is true
bin/dochazka-resetdb view on Meta::CPAN
# - destroy existing database, user and create a new one from scratch
set -e
help() {
echo
echo "Sets up a dochazka database and user. Needs to be run on the DB PostgreSQL server."
echo
echo "Options:"
echo "-d <database> The database name. Default: dochazka-test"
echo "-u <user> The database user. Default: dochazka"
echo "-p <password> The database user's password. Default: dochazka"
echo
}
[[ $1 == '--help' ]] && help && exit 0
DBNAME="dochazka-test"
DBUSER=dochazka
DBPASS=dochazka
while getopts d:u:p:h arg; do
config/REST_Config.pm view on Meta::CPAN
# number of seconds after which a session will be considered stale
set( 'DOCHAZKA_REST_SESSION_EXPIRATION_TIME', 3600 );
# DOCHAZKA_PROFILE_EDITABLE_FIELDS
# which employee fields can be updated by employees with privlevel 'inactive' and 'active'
# N.B. 1 administrators can edit all fields, and passerbies can't edit any
# N.B. 2 if LDAP authentication and LDAP import/sync are being used, it may not
# make sense for employees to edit *any* of the fields
# N.B. 3 this site param affects the functioning of the "POST employee/self" and "POST employee/current" resources
set( 'DOCHAZKA_PROFILE_EDITABLE_FIELDS', {
'inactive' => [ 'password' ],
'active' => [ 'password' ],
});
# DOCHAZKA_INTERVAL_SELECT_LIMIT
# upper limit on number of intervals fetched (for sanity, to avoid
# overly huge result sets)
set( 'DOCHAZKA_INTERVAL_SELECT_LIMIT', undef );
# DOCHAZKA_INTERVAL_DELETE_LIMIT
# highest possible number of intervals that can be deleted at one time
set( 'DOCHAZKA_INTERVAL_DELETE_LIMIT', 250 );
config/sql/dbinit_Config.pm view on Meta::CPAN
#
# DBINIT_CONNECT_SUPERUSER
# DBINIT_CONNECT_SUPERAUTH
#
# These should be overrided in Dochazka_SiteConfig.pm with real
# superuser credentials (but only for testing - do not put production
# credentials in any configuration file!!!!)
#
set( 'DBINIT_CONNECT_SUPERUSER', 'postgres' );
set( 'DBINIT_CONNECT_SUPERAUTH', 'bogus_password_to_be_overrided' );
#
# DBINIT_CREATE
#
# A list of SQL statements that are executed when the database is first
# created, to set up the table structure, etc. -- see the create_tables
# subroutine in REST.pm
#
set( 'DBINIT_CREATE', [
ext/REST_SiteConfig.pm.example view on Meta::CPAN
#set( 'DOCHAZKA_REST_SESSION_EXPIRATION_TIME', 3600 );
# DOCHAZKA_PROFILE_EDITABLE_FIELDS
# which employee fields can be updated by employees with privlevel 'inactive' and 'active'
# N.B. 1 administrators can edit all fields, and passerbies can't edit any
# N.B. 2 if LDAP authentication and LDAP import/sync are being used, it may not
# make sense for employees to edit *any* of the fields
# N.B. 3 this site param affects the functioning of the "POST
# employee/self" and "POST employee/current" resources
#set( 'DOCHAZKA_PROFILE_EDITABLE_FIELDS', {
# 'inactive' => [ 'password' ],
# 'active' => [ 'password' ],
#});
# DOCHAZKA_INTERVAL_SELECT_LIMIT
# upper limit on number of intervals fetched (for sanity, to avoid
# overly huge result sets)
#set( 'DOCHAZKA_INTERVAL_SELECT_LIMIT', undef );
# DOCHAZKA_INTERVAL_DELETE_LIMIT
# highest possible number of intervals that can be deleted at one time
#set( 'DOCHAZKA_INTERVAL_DELETE_LIMIT', 250 );
lib/App/Dochazka/REST/Auth.pm view on Meta::CPAN
# get database connection for this HTTP request
App::Dochazka::REST::ConnBank::init_singleton();
if ( ! $meta->META_DOCHAZKA_UNIT_TESTING ) {
return 1 if $self->_validate_session;
}
if ( $auth_header ) {
$log->debug("is_authorized: auth header is $auth_header" );
my $username = $auth_header->username;
my $password = $auth_header->password;
my $auth_status = $self->_authenticate( $username, $password );
if ( $auth_status->ok ) {
my $emp = $auth_status->payload;
$self->push_onto_context( {
current => $emp->TO_JSON,
current_obj => $emp,
current_priv => $emp->priv( $dbix_conn ),
dbix_conn => $dbix_conn,
} );
$self->_init_session( $emp ) unless $meta->META_DOCHAZKA_UNIT_TESTING;
return 1;
lib/App/Dochazka/REST/Auth.pm view on Meta::CPAN
$log->error( "Session expired!" );
return 0;
}
return 1;
}
=head3 _authenticate
Authenticate the nick associated with an incoming REST request. Takes a nick
and a password (i.e., a set of credentials). Returns a status object, which
will have level 'OK' on success (with employee object in the payload), 'NOT_OK'
on failure. In the latter case, there will be a declared status.
=cut
sub _authenticate {
my ( $self, $nick, $password ) = @_;
my ( $status, $emp );
$log->debug( "Entering " . __PACKAGE__ . "::_authenticate" );
# empty credentials: fall back to demo/demo
if ( $nick ) {
$log->notice( "Login attempt from $nick" );
} else {
$log->notice( "Login attempt from (anonymous) -- defaulting to demo/demo" );
$nick = 'demo';
$password = 'demo';
}
$log->debug( "\$site->DOCHAZKA_LDAP is " . $site->DOCHAZKA_LDAP );
# check if LDAP is enabled and if the employee exists in LDAP
if ( ! $meta->META_DOCHAZKA_UNIT_TESTING and
$site->DOCHAZKA_LDAP and
ldap_exists( $nick )
) {
$log->info( "Detected authentication attempt from $nick, a known LDAP user" );
#$log->debug( "Password provided: $password" );
# - authenticate by LDAP bind
if ( ldap_auth( $nick, $password ) ) {
# successful LDAP auth: if the employee doesn't already exist in
# the database, possibly autocreate
$status = autocreate_employee( $dbix_conn, $nick );
return $status unless $status->ok;
} else {
return $CELL->status_not_ok( 'DOCHAZKA_EMPLOYEE_AUTH' );
}
# load the employee object
my $emp = App::Dochazka::REST::Model::Employee->load_by_nick( $dbix_conn, $nick )->payload;
die "missing employee object in _authenticate" unless ref($emp) eq "App::Dochazka::REST::Model::Employee";
return $CELL->status_ok( 'DOCHAZKA_EMPLOYEE_AUTH', payload => $emp );
}
# if not, authenticate against the password stored in the employee object.
else {
$log->notice( "Employee $nick not found in LDAP; reverting to internal auth" );
# - check if this employee exists in database
my $emp = nick_exists( $dbix_conn, $nick );
if ( ! defined( $emp ) or ! $emp->isa( 'App::Dochazka::REST::Model::Employee' ) ) {
$log->notice( "Rejecting login attempt from unknown user $nick" );
$self->mrest_declare_status( explanation => "Authentication failed for user $nick", permanent => 1 );
return $CELL->status_not_ok;
}
# - the password might be empty
$password = '' unless defined( $password );
my $passhash = $emp->passhash;
$passhash = '' unless defined( $passhash );
# - check password against passhash
my ( $ppr, $status );
try {
$ppr = Authen::Passphrase::SaltedDigest->new(
algorithm => "SHA-512",
salt_hex => $emp->salt,
hash_hex => $emp->passhash,
);
} catch {
$status = $CELL->status_err( 'DOCHAZKA_PASSPHRASE_EXCEPTION', args => [ $_ ] );
};
if ( ref( $ppr ) ne 'Authen::Passphrase::SaltedDigest' ) {
$log->crit( "employee $nick has invalid passhash and/or salt" );
return $CELL->status_not_ok( 'DOCHAZKA_EMPLOYEE_AUTH' );
}
if ( $ppr->match( $password ) ) {
$log->notice( "Internal auth successful for employee $nick" );
return $CELL->status_ok( 'DOCHAZKA_EMPLOYEE_AUTH', payload => $emp );
} else {
$self->mrest_declare_status( explanation =>
"Internal auth failed for known employee $nick (mistyped password?)"
);
return $CELL->status_not_ok;
}
}
}
=head2 forbidden
This overrides the L<Web::Machine> method of the same name.
lib/App/Dochazka/REST/ConnBank.pm view on Meta::CPAN
our $dbix_conn;
=head1 FUNCTIONS
=head2 get_arbitrary_dbix_conn
Wrapper for DBIx::Connector->new. Takes database name, database user and
password. Returns a DBIx::Connector object (even if the database is
unreachable).
=cut
sub get_arbitrary_dbix_conn {
my ( $dbname, $dbuser, $dbpass ) = @_;
my $dbhost = $site->DOCHAZKA_DBHOST;
my $dbport = $site->DOCHAZKA_DBPORT;
my $dbsslmode = $site->DOCHAZKA_DBSSLMODE;
lib/App/Dochazka/REST/Docs/Workflow.pm view on Meta::CPAN
privlevels are recorded in a "history table".
Since inactive employees are still employees (or members of the organization),
they are authorized to view (retrieve) their privilege/schedule histories using
the C<schedule/history/self/?:tsrange> and C<priv/history/self/?:tsrange>
resources.
=head3 Edit one's own employee profile (certain fields)
Inactive employees are authorized to edit certain fields of their employee
profile (e.g., to change their password or correct the spelling of their full
name, etc.). These fields are configurable via the DOCHAZKA_PROFILE_EDITABLE_FIELDS site
parameter.
=head3 Retrieve one's own attendance/lock intervals
Although inactive employees are not authorized to enter new attendance/lock
intervals, they can retrieve their own past intervals, for example by browsing
in the web client, etc.
=head3 Generate reports
lib/App/Dochazka/REST/Guide.pm view on Meta::CPAN
bash$ psql postgres
postgres-# ALTER ROLE postgres WITH PASSWORD 'mypass';
ALTER ROLE
At this point, we exit C<psql> and, still as the user C<postgres>, we
edit C<pg_hba.conf>. In SUSE distributions, this file is located in
C<data/> under the C<postgres> home directory. Using our favorite editor,
we change the METHOD entry for C<local> so it looks like this:
# TYPE DATABASE USER ADDRESS METHOD
local all all password
For the audit triggers to work (and the application will not run otherwise), we
must to add the following line to the end of C<postgresql.conf> (also
located in C<data/> in SUSE distros):
dochazka.eid = -1
Then, as root, we restart the postgresql service:
bash# systemctl restart postgresql.service
Lastly, check if you can connect to the C<postgres> database using the password:
bash$ psql --username postgres postgres
Password for user postgres: [...type 'mypass'...]
psql (9.2.7)
Type "help" for help.
postgres=#
To exit, type C<\q> at the postgres prompt:
postgres=# \q
bash$
=head2 Site configuration
Before the Dochazka REST database can be initialized, we will need to
tell L<App::Dochazka::REST> about the PostgreSQL superuser password
that we set in the previous step. This is done via a site parameter.
There may be other site params we will want to set, but the following
is sufficient to run the test suite.
First, create a sitedir:
bash# mkdir /etc/dochazka-rest
and, second, a file therein:
# cat << EOF > /etc/dochazka-rest/REST_SiteConfig.pm
set( 'MREST_DEBUG_MODE', 1 );
set( 'DBINIT_CONNECT_SUPERAUTH', 'mypass' );
set( 'DOCHAZKA_REST_LOG_FILE', "dochazka-rest.log" );
set( 'DOCHAZKA_REST_LOG_FILE_RESET', 1);
EOF
#
Where 'mypass' is the PostgreSQL password you set in the 'ALTER
ROLE' command, above.
The C<DBINIT_CONNECT_SUPERAUTH> setting is only needed for database
initialization (see below), when L<App::Dochazka::REST> connects to PostgreSQL
as user 'postgres' to drop/create the database. Once the database is created,
L<App::Dochazka::REST> connects to it using the PostgreSQL credentials of the
current user.
=head2 Database initialization
lib/App/Dochazka/REST/Guide.pm view on Meta::CPAN
=head1 BASIC PARAMETERS
=head2 UTF-8
The server assumes all incoming requests are encoded in UTF-8, and it encodes
all of its responses in UTF-8 as well.
=head2 HTTP(S)
In order to protect user passwords from network sniffing and other nefarious
activities, it is recommended that the server be set up to accept HTTPS
requests only.
=head2 Self-documenting
Another implication of REST is that the server provides "resources" and that
those resources are, to some extent at least, self-documenting.
lib/App/Dochazka/REST/Guide.pm view on Meta::CPAN
headers, the client needs to be capable of displaying those as well.
One such client is Daniel Stenberg's B<curl>.
In the HTTP request, the client may provide an C<Accept:> header specifying
either HTML (C<text/html>) or JSON (C<application/json>). For the convenience
of those using a web browser, HTML is the default.
Here are some examples of how to use B<curl> (or a web browser) to explore
resources. These examples assume a vanilla installation of
L<App::Dochazka::REST> with the default root password. The same commands can be
used with a production server, but keep in mind that the resources you will see
may be limited by your privilege level.
=over
=item * GET resources
The GET method is used to search for and display information. The top-level
GET resources are listed at the top-level URI, either using B<curl>
lib/App/Dochazka/REST/Guide.pm view on Meta::CPAN
=item * fullname
=item * email
=back
All four of these, plus the C<eid> field, have C<UNIQUE> constraints defined at
the database level, meaning that duplicate entries are not permitted. However,
of the four, only C<nick> is required.
Depending on how authentication is set up, employee passwords may also be
stored in this table, using the C<passhash> and C<salt> fields.
For details, see L<App::Dochazka::REST::Model::Employee>.
=head2 Privhistory
Dochazka has four privilege levels: C<admin>, C<active>, C<inactive>, and
C<passerby>:
lib/App/Dochazka/REST/Guide.pm view on Meta::CPAN
=over
=item * lookup phase
=item * authentication phase
=back
The purpose of the lookup phase is to determine if the user exists in the
LDAP resource and, if it does exist, to get its 'cn' property. In the second
phase, the password entered by the user is compared with the password stored
in the LDAP resource.
If the LDAP lookup phase fails, or if LDAP is disabled, L<App::Dochazka::REST>
falls back to "internal authentication", which means that the credentials are
compared against the C<nick>, C<passhash>, and C<salt> fields of the
C<employees> table in the database.
To protect user credentials from snooping, the actual passwords are not stored
in the database, Instead, they are run through a one-way hash function and
the hash (along with a random "salt" string) is stored in the database instead
of the password itself. Since some "one-way" hashing algorithms are subject to
brute force attacks, the Blowfish algorithm was chosen to provide the best
known protection.
If the request passes Basic Authentication, a session ID is generated and
stored in a cookie.
=head1 AUTHORIZATION
lib/App/Dochazka/REST/LDAP.pm view on Meta::CPAN
last;
}
}
return $prop_value if $count > 0;
return;
}
=head2 ldap_auth
Takes a nick and a password. Returns true or false. Determines if the password matches
the one stored in the LDAP database.
=cut
sub ldap_auth {
no strict 'subs';
my ( $nick, $password ) = @_;
return 0 unless $nick;
$password = $password || '';
return 0 unless $site->DOCHAZKA_LDAP;
require Net::LDAP;
require Net::LDAP::Filter;
my $mesg = $ldap->bind( "$dn",
password => "$password",
);
if ( $mesg->code == 0 ) {
$ldap->unbind;
$log->info("Access granted to $nick");
return 1;
}
$log->info("Access denied to $nick because LDAP server returned code " . $mesg->code);
return 0;
}
lib/App/Dochazka/REST/Model/Employee.pm view on Meta::CPAN
Dochazka does not check if the email address is valid.
Depending on how C<App::Dochazka::REST> is configured (see especially the
C<DOCHAZKA_PROFILE_EDITABLE_FIELDS> site parameter), these fields may be
read-only for employees (changeable by admins only), or the employee may be
allowed to maintain their own information.
=head3 passhash, salt
The optional passhash and salt fields are designed to hold a hashed password
and random salt. See L<App::Dochazka::REST::Guide/AUTHENTICATION AND SESSION
MANAGEMENT> for details.
=head3 supervisor
If the employee has a supervisor who will use Dochazka to monitor the
employee's attendance, and provided that supervisor has an EID, this field can
be used to set up the relationship.
lib/App/Dochazka/REST/Shared.pm view on Meta::CPAN
use App::Dochazka::REST::ACL qw( acl_check_is_me acl_check_is_my_report );
use App::Dochazka::REST::ConnBank qw( conn_status );
use App::Dochazka::REST::Model::Activity;
use App::Dochazka::REST::Model::Employee;
use App::Dochazka::REST::Model::Interval;
use App::Dochazka::REST::Model::Lock;
use App::Dochazka::REST::Model::Privhistory;
use App::Dochazka::REST::Model::Schedhistory;
use App::Dochazka::REST::Model::Schedule;
use App::Dochazka::REST::Model::Shared qw( priv_by_eid schedule_by_eid );
use App::Dochazka::REST::Util qw( hash_the_password pre_update_comparison );
use Data::Dumper;
use Params::Validate qw( :all );
use Try::Tiny;
my $fail = $CELL->status_not_ok;
=head1 NAME
App::Dochazka::REST::Dispatch::Shared - Shared dispatch functions
lib/App/Dochazka/REST/Shared.pm view on Meta::CPAN
$d_obj->mrest_declare_status( code => 400, explanation => $explanation );
return $fail;
}
delete $over->{'eid'};
if ( $over == {} ) {
$d_obj->mrest_declare_status( code => 400, explanation => $explanation );
return $fail;
}
}
# for password hashing, we will assume that $over might contain
# a 'password' property, which is converted into 'passhash' + 'salt' via
# Authen::Passphrase
hash_the_password( $over );
return $emp->update( $d_obj->context ) if pre_update_comparison( $emp, $over );
$log->notice( "Update operation would not change database; skipping it" );
return $CELL->status_ok( 'DISPATCH_UPDATE_NO_CHANGE_OK' );
}
=head2 shared_insert_employee
Called from handlers in L<App::Dochazka::REST::Dispatch>. Takes three arguments:
lib/App/Dochazka/REST/Shared.pm view on Meta::CPAN
sub shared_insert_employee {
$log->debug( "Entered " . __PACKAGE__ . "::shared_insert_employee" );
my ( $d_obj, $ignore_me, $new_emp_props ) = validate_pos( @_,
{ isa => 'App::Dochazka::REST::Dispatch' },
{ type => UNDEF },
{ type => HASHREF },
);
$log->debug( "Arguments are OK, about to insert new employee: " . Dumper( $new_emp_props ) );
# If there is a "password" property, transform it into "passhash" + "salt"
hash_the_password( $new_emp_props );
# spawn an object, filtering the properties first
my @filtered_args = App::Dochazka::Common::Model::Employee::filter( %$new_emp_props );
my %proplist_after = @filtered_args;
$log->debug( "Properties after filter: " . join( ' ', keys %proplist_after ) );
my $emp = App::Dochazka::REST::Model::Employee->spawn( @filtered_args );
# execute the INSERT db operation
return $emp->insert( $d_obj->context );
}
lib/App/Dochazka/REST/Test.pm view on Meta::CPAN
package App::Dochazka::REST::Test;
use strict;
use warnings;
use App::CELL qw( $CELL $log $meta $site );
use App::Dochazka::Common;
use App::Dochazka::REST;
use App::Dochazka::REST::Dispatch;
use App::Dochazka::REST::ConnBank qw( $dbix_conn conn_up );
use App::Dochazka::REST::Util qw( hash_the_password );
use App::Dochazka::REST::Model::Activity;
use App::Dochazka::REST::Model::Component;
use App::Dochazka::REST::Model::Privhistory qw( get_privhistory );
use App::Dochazka::REST::Model::Schedhistory qw( get_schedhistory );
use App::Dochazka::REST::Model::Shared qw( cud_generic noof select_single );
use Authen::Passphrase::SaltedDigest;
use Data::Dumper;
use HTTP::Request::Common qw( GET PUT POST DELETE );
use JSON;
use Params::Validate qw( :all );
lib/App/Dochazka/REST/Test.pm view on Meta::CPAN
my $pass;
if ( $user eq 'root' ) {
$pass = 'immutable';
} elsif ( $user eq 'inactive' ) {
$pass = 'inactive';
} elsif ( $user eq 'active' ) {
$pass = 'active';
} elsif ( $user eq 'demo' ) {
$pass = 'demo';
} else {
#diag( "Unusual user $user - trying password $user" );
$pass = $user;
}
$r->authorization_basic( $user, $pass );
note( "About to send request $method $resource as $user " . ( $json ? "with $json" : "" ) );
my $res = $test->request( $r );
$code += 0;
if ( $code != $res->code ) {
diag( Dumper $res );
BAIL_OUT(0);
lib/App/Dochazka/REST/Test.pm view on Meta::CPAN
Returns the new Employee object.
=cut
sub create_bare_employee {
my ( $PROPS ) = validate_pos( @_,
{ type => HASHREF },
);
hash_the_password( $PROPS );
my $emp = App::Dochazka::REST::Model::Employee->spawn( $PROPS );
is( ref($emp), 'App::Dochazka::REST::Model::Employee', 'create_bare_employee 1' );
my $status = $emp->insert( $faux_context );
if ( $status->not_ok ) {
diag( "Employee insert method returned NOT_OK status in create_bare_employee" );
diag( "test automation function, which was called from " . (caller)[1] . " line " . (caller)[2] );
diag( "with arguments: " . Dumper( $PROPS ) );
diag( "Full status returned by employee insert method:" );
lib/App/Dochazka/REST/Test.pm view on Meta::CPAN
}
is( $status->level, 'OK', 'delete_bare_employee 2' );
return;
}
sub _create_employee {
my ( $test, $privspec ) = @_;
note("create $privspec employee");
my $eid = create_bare_employee( { nick => $privspec, password => $privspec } )->eid;
my $status = req( $test, 201, 'root', 'POST', "priv/history/eid/$eid",
"{ \"effective\":\"1892-01-01\", \"priv\":\"$privspec\" }" );
ok( $status->ok, "Create $privspec employee 2" );
is( $status->code, 'DOCHAZKA_CUD_OK', "Create $privspec employee 3" );
return $eid;
}
=head2 create_active_employee
lib/App/Dochazka/REST/Util.pm view on Meta::CPAN
=head1 EXPORTS
This module provides the following exports:
=over
=item L<hash_the_password> (function)
=item L<pod_to_html> (function)
=item L<pre_update_comparison> (function)
=back
=cut
use Exporter qw( import );
our @EXPORT_OK = qw(
hash_the_password
pod_to_html
pre_update_comparison
);
=head1 FUNCTIONS
=head2 hash_the_password
Takes a request entity (hashref) - looks for a 'password' property. If it
is present, adds a random salt to the request entity and hashes the
password with it. If there is no password property, the function does
nothing.
=cut
sub hash_the_password {
my $entity = shift;
if ( $entity->{'password'} ) {
my $ppr = Authen::Passphrase::SaltedDigest->new(
algorithm => "SHA-512", salt_random => 20,
passphrase => $entity->{'password'}
);
delete $entity->{'password'};
$entity->{'passhash'} = $ppr->hash_hex;
$entity->{'salt'} = $ppr->salt_hex;
}
}
=head2 pod_to_html
Each L<App::Dochazka::REST> resource definition includes a 'documentation'
property containing a POD string. Our 'docu/html' resource converts this
run-tests.sh view on Meta::CPAN
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
# *************************************************************************
#
# run-tests.sh
#
# Resets the database in preparation for running the test suite. Set PGPASSWORD
# environment variable to avoid the password prompt.
#
perl Build.PL
./Build
sudo ./Build install 2>&1 >/dev/null
dochazka-resetdb 2>&1 >/dev/null
dochazka-dbinit
# do this manually:
#prove -lr t/
t/dispatch/employee.t view on Meta::CPAN
note( "looping: PUT $base" );
$status = req( $test, 405, 'demo', 'PUT', $base );
$status = req( $test, 405, 'active', 'PUT', $base );
$status = req( $test, 405, 'root', 'PUT', $base );
note( "looping: POST $base" );
note( "- default configuration is that 'active' and 'inactive' can modify" );
note( ' their own passhash and salt fields; demo should *not* be ' );
note( ' authorized to do this' );
req( $test, 403, 'demo', 'POST', $base, '{ "password":"saltine" }' );
foreach my $user ( "active", "inactive" ) {
#
#diag( "$user $base " . '{ "password" : "saltine" }' );
$status = req( $test, 200, $user, 'POST', $base, '{ "password" : "saltine" }' );
if ( $status->not_ok ) {
diag( Dumper $status );
BAIL_OUT(0);
}
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
note( '- use root to change it back, otherwise the user won\'t be able' );
note( ' to log in and next tests will fail' );
$status = req( $test, 200, 'root', 'PUT', "employee/nick/$user", "{ \"password\" : \"$user\" }" );
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
note( '- legal but bogus JSON in body' );
$status = req( $test, 200, $user, 'POST', $base, 0 );
is( $status->level, 'OK' );
is( $status->code, 'DISPATCH_UPDATE_NO_CHANGE_OK' );
note( "- 'salt' is a permitted field, but 'inactive'/$user employees" );
note( " should not, for example, be allowed to change 'nick'" );
t/dispatch/employee.t view on Meta::CPAN
req( $test, 405, 'demo', 'GET', $base );
req( $test, 405, 'active', 'GET', $base );
req( $test, 405, 'root', 'GET', $base );
req( $test, 405, 'demo', 'PUT', $base );
req( $test, 405, 'active', 'PUT', $base );
req( $test, 405, 'root', 'PUT', $base );
note( "POST: $base" );
note( "create a 'mrfu' employee" );
my $mrfu = create_bare_employee( { nick => 'mrfu', password => 'mrfu' } );
my $eid_of_mrfu = $mrfu->eid;
# these tests break when 'email' is added to DOCHAZKA_PROFILE_EDITABLE_FIELDS
## - give Mr. Fu an email address
##req( $test, 403, 'demo', 'POST', $base, '{ "eid": ' . $mrfu->eid . ', "email" : "shake it" }' );
#
##is( $mrfu->nick, 'mrfu' );
##req( $test, 403, 'mrfu', 'POST', $base, '{ "eid": ' . $mrfu->eid . ', "email" : "shake it" }' );
# fails because mrfu is a passerby
t/dispatch/employee.t view on Meta::CPAN
EOH
is( $status->level, "OK", 'POST employee/eid 3' );
is( $status->code, "DOCHAZKA_CUD_OK", 'POST employee/eid 3' );
ok( exists $status->payload->{'phid'} );
my $mrfu_phid = $status->payload->{'phid'};
# these tests break when 'email' is added to DOCHAZKA_PROFILE_EDITABLE_FIELDS
## - try the operation again - it still fails because inactives can not change their email
##req( $test, 403, 'mrfu', 'POST', $base, '{ "eid": ' . $mrfu->eid . ', "email" : "shake it" }' );
note( "inactive mrfu can change his password" );
$status = req( $test, 200, 'mrfu', 'POST', $base, '{ "eid": ' . $mrfu->eid . ', "password" : "shake it" }' );
is( $status->level, "OK", 'POST employee/eid 3' );
is( $status->code, 'DOCHAZKA_CUD_OK', 'POST employee/eid 4' );
note( "but now mrfu cannot log in, because req assumes password is 'mrfu'" );
req( $test, 401, 'mrfu', 'GET', 'employee/nick/mrfu' );
note( "so, use root powers to change the password back" );
$eid_of_mrfu = $mrfu->eid;
$status = req( $test, 200, 'root', 'POST', $base, <<"EOH" );
{ "eid" : $eid_of_mrfu, "password" : "mrfu" }
EOH
is( $status->level, "OK", 'POST employee/eid 3' );
is( $status->code, "DOCHAZKA_CUD_OK", 'POST employee/eid 3' );
note( "and now mrfu can log in" );
$status = req( $test, 200, 'mrfu', 'GET', 'employee/nick/mrfu' );
is( $status->level, "OK", 'POST employee/eid 3' );
is( $status->payload->{'remark'}, undef );
is( $status->payload->{'sec_id'}, undef );
is( $status->payload->{'nick'}, 'mrfu' );
t/dispatch/employee.t view on Meta::CPAN
{ "eid" : $eid, "nick" : "tHE gREAT fABULATOR" }
EOH
}
foreach my $user ( qw( inactive active ) ) {
$status = req( $test, 200, 'root', 'GET', "employee/nick/$user" );
is( $status->level, 'OK' );
is( $status->code, 'DISPATCH_EMPLOYEE_FOUND' );
is( ref( $status->payload ), 'HASH' );
my $eid = $status->payload->{'eid'};
$status = req( $test, 200, $user, 'POST', $base, <<"EOH" );
{ "eid" : $eid, "password" : "tHE gREAT fABULATOR" }
EOH
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
note( "$user can no longer log in because Test.pm expects password to be same as $user" );
req( $test, 401, $user, 'GET', "employee/nick/$user" );
note( "use root power to change $user\'s password back to $user" );
$status = req( $test, 200, 'root', 'POST', $base, <<"EOH" );
{ "eid" : $eid, "password" : "$user" }
EOH
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
}
note( "teardown: delete the testing user mrfu" );
note( "first, delete his privhistory entry" );
t/dispatch/employee.t view on Meta::CPAN
{ "nick" : "tHE gREAT fABULATOR" }
EOH
}
foreach my $user ( qw( inactive active ) ) {
$status = req( $test, 200, 'root', 'GET', "employee/nick/$user" );
is( $status->level, 'OK' );
is( $status->code, 'DISPATCH_EMPLOYEE_FOUND' );
is( ref( $status->payload ), 'HASH' );
my $eid = $status->payload->{'eid'};
$status = req( $test, 200, $user, 'PUT', "$base/$eid", <<"EOH" );
{ "password" : "tHE gREAT fABULATOR" }
EOH
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
note( "so far so good, but now we can\'t log in because Test.pm assumes password is $user" );
req( $test, 401, $user, 'GET', "$base/$eid" );
note( 'change it back' );
$status = req( $test, 200, 'root', 'PUT', "$base/$eid", "{ \"password\" : \"$user\" }" );
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
note( 'working again' );
$status = req( $test, 200, 'root', 'GET', "employee/nick/$user" );
is( $status->level, 'OK' );
is( $status->code, 'DISPATCH_EMPLOYEE_FOUND' );
is( ref( $status->payload ), 'HASH' );
}
t/dispatch/employee.t view on Meta::CPAN
note( 'attempt to change nick to null' );
dbi_err( $test, 500, 'root', 'PUT', "$base/hapless",
'{ "nick":null }', qr/violates not-null constraint/ );
note( 'feed it some random bogusness' );
$status = req( $test, 200, 'root', 'PUT', "$base/hapless", '{ "legal" : "json" }' );
is( $status->level, 'OK' );
is( $status->code, 'DISPATCH_UPDATE_NO_CHANGE_OK' );
note( 'inactive and active users can not change passwords of other users' );
foreach my $user ( qw( demo inactive active ) ) {
foreach my $target ( qw( mrsfu hapless ) ) {
req( $test, 403, $user, 'PUT', "$base/$target", <<"EOH" );
{ "passhash" : "HAHAHAHA" }
EOH
}
}
note( 'clean up testing employees' );
delete_bare_employee( $eid_of_mrsfu );
t/dispatch/fillup.t view on Meta::CPAN
ok( $status->{'payload'} );
ok( $status->{'payload'}->{'shid'} );
#ok( $status->{'payload'}->{'schedule'} );
note( $note = 'create testing employee \'inactive\' with \'inactive\' privlevel' );
$log->info( "=== $note" );
my $eid_inactive = create_inactive_employee( $test );
note( $note = 'create testing employee \'bubba\' with \'active\' privlevel' );
$log->info( "=== $note" );
my $eid_bubba = create_bare_employee( { nick => 'bubba', password => 'bubba' } )->eid;
$status = req( $test, 201, 'root', 'POST', 'priv/history/nick/bubba', <<"EOH" );
{ "eid" : $eid_bubba, "priv" : "active", "effective" : "1967-06-17 00:00" }
EOH
is( $status->level, "OK" );
is( $status->code, "DOCHAZKA_CUD_OK" );
$status = req( $test, 200, 'root', 'GET', 'priv/nick/bubba' );
is( $status->level, "OK" );
is( $status->code, "DISPATCH_EMPLOYEE_PRIV" );
ok( $status->{'payload'} );
is( $status->{'payload'}->{'priv'}, 'active' );
t/dispatch/interval_lock.t view on Meta::CPAN
is( $status->code, "DOCHAZKA_CUD_OK" );
ok( $status->{'payload'} );
ok( $status->{'payload'}->{'shid'} );
#ok( $status->{'payload'}->{'schedule'} );
}
note( 'create testing employee \'inactive\' with \'inactive\' privlevel' );
my $eid_inactive = create_inactive_employee( $test );
note( "create an active employee nicknamed 'super'" );
my $super = create_bare_employee( { nick => 'super', password => 'super' } );
my $eid_of_super = $super->eid;
my $status = req( $test, 201, 'root', 'POST', 'priv/history/nick/super', <<"EOH" );
{ "eid" : $eid_of_super, "priv" : "active", "effective" : "1967-06-17 00:00" }
EOH
is( $status->level, "OK" );
is( $status->code, "DOCHAZKA_CUD_OK" );
$status = req( $test, 200, 'root', 'GET', 'priv/nick/super' );
is( $status->level, "OK" );
is( $status->code, "DISPATCH_EMPLOYEE_PRIV" );
ok( $status->{'payload'} );
is( $status->{'payload'}->{'priv'}, 'active' );
note( 'create testing employee \'bubba\' with \'active\' privlevel' );
my $bubba = create_bare_employee( { nick => 'bubba', password => 'bubba' } );
my $eid_of_bubba = $bubba->eid;
$status = req( $test, 201, 'root', 'POST', 'priv/history/nick/bubba', <<"EOH" );
{ "eid" : $eid_of_bubba, "priv" : "active", "effective" : "1967-06-17 00:00" }
EOH
is( $status->level, "OK" );
is( $status->code, "DOCHAZKA_CUD_OK" );
$status = req( $test, 200, 'root', 'GET', 'priv/nick/bubba' );
is( $status->level, "OK" );
is( $status->code, "DISPATCH_EMPLOYEE_PRIV" );
ok( $status->{'payload'} );
t/dispatch/supervisor.t view on Meta::CPAN
note( 'instantiate Plack::Test object');
my $test = Plack::Test->create( $app );
note( 'create a testing schedule' );
my $sid = create_testing_schedule( $test );
note( 'create testing user boss' );
my $boss_eid = create_active_employee( $test );
req( $test, 200, 'root', 'PUT', "employee/eid/$boss_eid", "{ \"nick\" : \"boss\" }" );
req( $test, 200, 'root', 'PUT', "employee/eid/$boss_eid", "{ \"password\" : \"boss\" }" );
note( 'create testing user peon' );
my $peon_eid = create_active_employee( $test );
req( $test, 200, 'root', 'PUT', "employee/eid/$peon_eid", "{ \"nick\" : \"peon\" }" );
req( $test, 200, 'root', 'PUT', "employee/eid/$peon_eid", "{ \"supervisor\" : $boss_eid }" );
req( $test, 200, 'root', 'PUT', "employee/eid/$peon_eid", "{ \"password\" : \"peon\" }" );
note( 'create testing user active' );
my $active_eid = create_active_employee( $test );
note( 'give \'peon\' a schedule as of 1957-01-01 00:00 so he can enter some attendance intervals' );
my @shid_for_deletion;
my $status = req( $test, 201, 'root', 'POST', "schedule/history/nick/peon", <<"EOH" );
{ "sid" : $sid, "effective" : "1957-01-01 00:00" }
EOH
is( $status->level, "OK" );
t/dispatch/top.t view on Meta::CPAN
note( 'GET echo -> 405' );
$status = req( $test, 405, 'demo', 'GET', 'echo' );
$status = req( $test, 405, 'root', 'GET', 'echo' );
note( 'PUT echo -> 405' );
$status = req( $test, 405, 'demo', 'PUT', 'echo' );
$status = req( $test, 405, 'root', 'PUT', 'echo' );
note( 'POST echo' );
note( '- as root, with legal JSON' );
$status = req( $test, 200, 'root', 'POST', 'echo', '{ "username": "foo", "password": "bar" }' );
is( $status->level, 'OK' );
is( $status->code, 'ECHO_REQUEST_ENTITY' );
ok( exists $status->payload->{'username'} );
is( $status->payload->{'username'}, 'foo' );
ok( exists $status->payload->{'password'} );
is( $status->payload->{'password'}, 'bar' );
note( '- with illegal JSON' );
$status = req( $test, 400, 'root', 'POST', 'echo', '{ "username": "foo", "password": "bar"' );
note( '- with empty request body, as demo' );
$status = req( $test, 403, 'demo', 'POST', 'echo' );
note( '- with empty request body' );
$status = req( $test, 200, 'root', 'POST', 'echo' );
is( $status->level, 'OK' );
is( $status->code, 'ECHO_REQUEST_ENTITY' );
ok( exists $status->{'payload'} );
is( $status->payload, undef );
t/fillup-bug-67.t view on Meta::CPAN
ok( $status->{'payload'} );
ok( $status->{'payload'}->{'shid'} );
#ok( $status->{'payload'}->{'schedule'} );
note( $note = 'create testing employee \'inactive\' with \'inactive\' privlevel' );
$log->info( "=== $note" );
my $eid_inactive = create_inactive_employee( $test );
note( $note = 'create testing employee \'bubba\' with \'active\' privlevel' );
$log->info( "=== $note" );
my $eid_bubba = create_bare_employee( { nick => 'bubba', password => 'bubba' } )->eid;
$status = req( $test, 201, 'root', 'POST', 'priv/history/nick/bubba', <<"EOH" );
{ "eid" : $eid_bubba, "priv" : "active", "effective" : "1967-06-17 00:00" }
EOH
is( $status->level, "OK" );
is( $status->code, "DOCHAZKA_CUD_OK" );
$status = req( $test, 200, 'root', 'GET', 'priv/nick/bubba' );
is( $status->level, "OK" );
is( $status->code, "DISPATCH_EMPLOYEE_PRIV" );
ok( $status->{'payload'} );
is( $status->{'payload'}->{'priv'}, 'active' );
note( $note = 'we do not try to vet non-existent employee objects here, because the Tempintvls' );
$log->info( "=== $note" );
note( $note = 'class is designed to be called from Dispatch.pm *after* the employee has been' );
$log->info( "=== $note" );
note( $note = 'determined to exist' );
$log->info( "=== $note" );
note( $note = 'create a testing employee with nick "active"' );
$log->info( "=== $note" );
my $active = create_bare_employee( { nick => 'active', password => 'active' } );
push my @eids_to_delete, $active->eid;
note( $note = 'vet active - no privhistory' );
$log->info( "=== $note" );
$status = $fo->_vet_employee( emp_obj => $active );
is( $status->level, 'ERR' );
is( $status->code, 'DISPATCH_EMPLOYEE_NO_PRIVHISTORY' );
note( $note = 'give active a privhistory' );
$log->info( "=== $note" );
$emp->fullname( undef );
is( $emp->fullname, undef );
$status = $emp->update( $faux_context );
ok( $status->ok );
note( "Assert that fullname field is empty" );
$status = req( $test, 200, 'root', 'GET', "employee/nick/$ex" );
is( $status->level, 'OK' );
is( $status->payload->{fullname}, undef );
note( "Set password of employee $ex to \"$ex\"" );
$status = req( $test, 200, 'root', 'PUT', "employee/nick/$ex",
"{\"password\":\"$ex\"}" );
is( $status->level, 'OK' );
note( "PUT employee/nick/$ex/ldap" );
$status = req( $test, 200, $ex, 'PUT', "employee/nick/$ex/ldap" );
is( $status->level, 'OK' );
note( "Assert that fullname field is populated as expected" );
$status = req( $test, 200, 'root', 'GET', "employee/nick/$ex" );
is( $status->level, 'OK' );
is( $status->payload->{fullname}, $saved_fullname );
( run in 1.182 second using v1.01-cache-2.11-cpan-49f99fa48dc )