rwpass.txt
ghpass.txt
+# QueryApp
+/QueryApp/Makefile
+/QueryApp/Makefile.old
+/QueryApp/META.yml
+/QueryApp/MYMETA.*
+/QueryApp/blib
+/QueryApp/inc
+/QueryApp/pm_to_blib
+
# OpenSSL-Query
/OpenSSL-Query/Makefile
/OpenSSL-Query/Makefile.old
--- /dev/null
+bin/query.psgi
+lib/OpenSSL/Query/ClaDB.pm
+lib/OpenSSL/Query/DB.pm
+lib/OpenSSL/Query/Role/Bureau.pm
+lib/OpenSSL/Query/PersonDB.pm
+Makefile.PL
+MANIFEST
+META.yml
+public/dispatch.fcgi
+public/dispatch.cgi
+t/query.t
+t/query_data/pdb.yaml
+t/query_data/cdb.txt
--- /dev/null
+use 5.006;
+use strict;
+use warnings;
+use inc::Module::Install;
+
+name 'QueryApp';
+version '0.0.1';
+abstract 'An OpenSSL query web app';
+author q{Richard Levitte <levitte@openssl.org>};
+license 'apache';
+
+perl_version 5.006;
+
+tests_recursive('t');
+
+resources (
+ license => 'http://www.apache.org/licenses/LICENSE-2.0',
+ #repository => 'git://github.com/Richard Levitte/OpenSSL-query.git',
+ #repository => 'https://bitbucket.org/Richard Levitte/OpenSSL-query',
+ bugtracker => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=OpenSSL-query',
+);
+
+configure_requires (
+ 'Module::Install' => 0,
+);
+
+build_requires (
+ 'Test::More' => 0,
+);
+
+requires (
+ 'File::Spec' => 0,
+ 'YAML::XS' => 0,
+ Moo => 0,
+ Carp => 0,
+ Dancer2 => 0,
+ Plack => 0,
+ 'OpenSSL::Query' => 0,
+);
+
+install_as_site;
+auto_install;
+WriteAll;
--- /dev/null
+#! /usr/bin/env perl
+#
+# Copyright 2017 The OpenSSL Project Authors. All Rights Reserved.
+#
+# Licensed under the OpenSSL license (the "License"). You may not use
+# this file except in compliance with the License. You can obtain a copy
+# in the file LICENSE in the source distribution or at
+# https://www.openssl.org/source/license.html
+
+use strict;
+use warnings;
+use Carp;
+
+# Currently supported API versions:</p>
+#
+# /0 : Version 0
+#
+# Version 0 API:
+#
+# /0/Person/:name
+#
+# Fetches the complete set of database information on :name.
+#
+# /0/Person/:name/Membership
+#
+# Fetches the groups (omc, omc-alumni or commit) that :name is
+# member of, with the date they became or were reinstated in the group
+#
+# /0/Person/:name/IsMemberOf/:group
+#
+# Fetches from what date :name became or was reinstated as member
+# of :group
+#
+# /0/Person/:name/ValueOfTag/:tag
+#
+# Fetches the value of :tag associated with :name. This tag is
+# usually application specific.
+#
+# /0/Person/:name/HasCLA
+#
+# Fetches the identity under which :name has a CLA, if any.
+#
+# /0/HasCLA/:id
+#
+# Checks if there is a CLA under the precise identity :id. This
+# differs from /0/Person/:name/HasCLA in that it demands the precise
+# identity (email address or committer id) that the CLA is registered
+# under, while /0/Person/:name/HasCLA checks for any CLA associated
+# with any of :name's identities and returns a list of what it finds.
+
+package query;
+use Dancer2;
+use HTTP::Status qw(:constants);
+use OpenSSL::Query::DB;
+
+set serializer => 'JSON';
+set bureau => '/var/cache/openssl/checkouts/bureau';
+
+# Version 0 API.
+# Feel free to add new routes, but never to change them or remove them,
+# or to change their response. For such changes, add a new version at
+# the end
+
+prefix '/0';
+
+get '/Person/:name' => sub {
+ my $query = OpenSSL::Query->new(bureau => config->{bureau});
+ my $name = route_parameters->get('name');
+ my %response = $query->find_person($name);
+
+ return { %response } if %response;
+ send_error('Not found', HTTP_NO_CONTENT);
+};
+
+get '/Person/:name/Membership' => sub {
+ my $query = OpenSSL::Query->new(bureau => config->{bureau}, REST => 0);
+ my $name = route_parameters->get('name');
+ my %response = $query->find_person($name);
+
+ return $response{memberof} if %response;
+ send_error('Not found', HTTP_NO_CONTENT);
+};
+
+get '/Person/:name/IsMemberOf/:group' => sub {
+ my $query = OpenSSL::Query->new(bureau => config->{bureau}, REST => 0);
+ my $name = route_parameters->get('name');
+ my $group = route_parameters->get('group');
+ my $response = $query->is_member_of($name, $group);
+
+ return [ $response ] if $response;
+ send_error('Not found', HTTP_NO_CONTENT);
+};
+
+get '/Person/:name/ValueOfTag/:tag' => sub {
+ my $query = OpenSSL::Query->new(bureau => config->{bureau}, REST => 0);
+ my $name = route_parameters->get('name');
+ my $tag = route_parameters->get('tag');
+ my $response = $query->find_person_tag($name, $tag);
+
+ return [ $response ] if $response;
+ send_error('Not found', HTTP_NO_CONTENT);
+};
+
+get '/Person/:name/HasCLA' => sub {
+ my $query = OpenSSL::Query->new(bureau => config->{bureau}, REST => 0);
+ my $name = route_parameters->get('name');
+ my %person = $query->find_person($name);
+ my $response = [];
+
+ foreach (@{$person{ids}}) {
+ next if (ref $_ eq "HASH");
+ push @$response, $_ if $query->has_cla($_);
+ }
+ send_error('Not found', HTTP_NO_CONTENT);
+};
+
+get '/HasCLA/:id' => sub {
+ my $query = OpenSSL::Query->new(bureau => config->{bureau}, REST => 0);
+ my $id = route_parameters->get('id');
+ my $response = $query->has_cla($id);
+
+ return [ $response ] if $response;
+ send_error('Not found', HTTP_NO_CONTENT);
+};
+
+# End of version 0 API. To create a new version, start with `prefix '1';'
+# below.
+
+dance;
--- /dev/null
+#! /usr/bin/env perl
+#
+# Copyright 2017 The OpenSSL Project Authors. All Rights Reserved.
+#
+# Licensed under the OpenSSL license (the "License"). You may not use
+# this file except in compliance with the License. You can obtain a copy
+# in the file LICENSE in the source distribution or at
+# https://www.openssl.org/source/license.html
+
+use strict;
+
+package OpenSSL::Query::ClaDB;
+use Carp;
+use Moo;
+use OpenSSL::Query qw(-register-cla OpenSSL::Query::ClaDB -priority 0);
+
+with q(OpenSSL::Query::Role::Bureau);
+
+has clafile => ( is => 'ro', default => 'cladb.txt' );
+has _cladb => ( is => 'lazy', builder => 1 );
+
+sub _build__cladb {
+ my $self = shift;
+
+ my $path = $self->_find_file($self->clafile, 'CLADB');
+ my $cladb = {};
+
+ open my $clafh, $path
+ or croak "Trying to open $path: $!";
+ while (my $line = <$clafh>) {
+ $line =~ s|\R$||; # Better chomp
+ next if $line =~ m|^#|;
+ next if $line =~ m|^\s*$|;
+ croak "Malformed CLADB line: $line"
+ unless $line =~ m|^(\S+\@\S+)\s+([ICR])\s+(.+)$|;
+ croak "Duplicate email address: $1"
+ if exists $cladb->{$1};
+
+ $cladb->{$1} = { status => $2, name => $3 };
+ }
+ close $clafh;
+
+ return $cladb;
+}
+
+sub has_cla {
+ my $self = shift;
+ my $id = shift;
+ if ($id =~ m|<(\S+\@\S+)>|) { $id = $1; }
+ croak "Malformed input ID" unless $id =~ m|^\S+(\@\S+)$|;
+ my $starid = '*' . $1;
+
+ return exists $self->_cladb->{$id} || exists $self->_cladb->{$starid};
+}
+
+1;
--- /dev/null
+#! /usr/bin/env perl
+#
+# Copyright 2017 The OpenSSL Project Authors. All Rights Reserved.
+#
+# Licensed under the OpenSSL license (the "License"). You may not use
+# this file except in compliance with the License. You can obtain a copy
+# in the file LICENSE in the source distribution or at
+# https://www.openssl.org/source/license.html
+
+use strict;
+
+package OpenSSL::Query::DB;
+use OpenSSL::Query::PersonDB;
+use OpenSSL::Query::ClaDB;
+1;
--- /dev/null
+#! /usr/bin/env perl
+#
+# Copyright 2017 The OpenSSL Project Authors. All Rights Reserved.
+#
+# Licensed under the OpenSSL license (the "License"). You may not use
+# this file except in compliance with the License. You can obtain a copy
+# in the file LICENSE in the source distribution or at
+# https://www.openssl.org/source/license.html
+
+use strict;
+
+package OpenSSL::Query::PersonDB;
+use Carp;
+use Moo;
+use OpenSSL::Query qw(-register-person OpenSSL::Query::PersonDB -priority 0);
+
+with q(OpenSSL::Query::Role::Bureau);
+
+has personfile => ( is => 'ro', default => 'persondb.yaml' );
+has _persondb => ( is => 'lazy', builder => 1 );
+
+use YAML::XS qw(LoadFile);
+
+sub _build__persondb {
+ my $self = shift;
+
+ my $yaml =
+ LoadFile( $self->_find_file($self->personfile, 'PERSONDB') );
+
+ croak "Malformed PersonDB" unless ref($yaml) eq "ARRAY";
+ foreach (@{$yaml}) {
+ croak "Malformed PersonDB"
+ unless (defined($_->{ids}) and defined($_->{memberof})
+ and ref($_->{ids}) eq "ARRAY" and ref($_->{memberof}) eq "HASH");
+ }
+
+ return $yaml;
+}
+
+sub find_person {
+ my $self = shift;
+ my $id = shift;
+
+ if (ref($id) eq "" && $id =~ m|<(\S+\@\S+)>|) { $id = $1; }
+ croak "Malformed input ID" if ref($id) eq "HASH" and scalar keys %$id != 1;
+
+ my $found = 0;
+ foreach my $record (@{$self->_persondb}) {
+ foreach my $rid (@{$record->{ids}}) {
+ if (ref($id) eq "") {
+ if (ref($rid) eq "HASH") {
+ foreach (keys %$rid) {
+ last if $found = $id eq $rid->{$_};
+ }
+ } else {
+ $found = $id eq $rid;
+ }
+ } elsif (ref($id) eq "HASH" && ref($rid) eq "HASH") {
+ foreach (keys %$rid) {
+ last if $found = exists $id->{$_} && $id->{$_} eq $rid->{$_};
+ }
+ }
+
+ return (wantarray ? %$record : 1) if $found;
+ }
+ }
+ return wantarray ? () : 0;
+}
+
+sub find_person_tag {
+ my $self = shift;
+ my $id = shift;
+ my $tag = shift;
+
+ my %record = $self->find_person($id);
+ return $record{tags}->{$tag};
+}
+
+sub is_member_of {
+ my $self = shift;
+ my $id = shift;
+ my $group = shift;
+
+ if ($id =~ m|<(\S+\@\S+)>|) { $id = $1; }
+
+ my %record = $self->find_person($id);
+ return $record{memberof}->{$group}
+ if exists $record{memberof}->{$group};
+ return 0;
+}
+
+1;
--- /dev/null
+#! /usr/bin/env perl
+#
+# Copyright 2017 The OpenSSL Project Authors. All Rights Reserved.
+#
+# Licensed under the OpenSSL license (the "License"). You may not use
+# this file except in compliance with the License. You can obtain a copy
+# in the file LICENSE in the source distribution or at
+# https://www.openssl.org/source/license.html
+
+use strict;
+
+package OpenSSL::Query::Role::Bureau;
+
+use File::Spec::Functions;
+use Moo::Role;
+
+has bureau => ( is => 'ro' );
+
+sub _find_file {
+ my $self = shift;
+ my $filename = shift;
+ my $envvar = shift;
+
+ my $bureau = $ENV{BUREAU} // $self->bureau;
+ my @paths = ( $ENV{$envvar} // (),
+ $bureau ? catfile($bureau, $filename) : (),
+ catfile('.', $filename) );
+ foreach (@paths) {
+ return $_ if -r $_;
+ }
+ die "$filename not found in any of ", join(", ", @paths), "\n";
+}
+
+1;
--- /dev/null
+#!/usr/bin/env perl
+
+# This means that 'dance' at the end of query.psgi will not start a built in
+# service, but will simply return a coderef. This is useful to run this with
+# diverse dispatchers as well as tests.
+BEGIN { $ENV{DANCER_APPHANDLER} = 'PSGI';}
+
+use Dancer2;
+use FindBin '$Bin';
+use lib path($Bin, '..', '..', 'lib'), path($Bin, '..', 'lib');
+use Plack::Handler::CGI;
+use Plack::Util;
+
+# For some reason Apache SetEnv directives dont propagate
+# correctly to the dispatchers, so forcing PSGI and env here
+# is safer.
+set apphandler => 'PSGI';
+set environment => 'production';
+
+my $app = Plack::Util::load_psgi( path($Bin, '..', 'bin', 'query.psgi') );
+die "Unable to read startup script: $@" if $@;
+Plack::Handler::CGI->new()->run($app);
--- /dev/null
+#!/usr/bin/env perl
+
+# This means that 'dance' at the end of query.psgi will not start a built in
+# service, but will simply return a coderef. This is useful to run this with
+# diverse dispatchers as well as tests.
+BEGIN { $ENV{DANCER_APPHANDLER} = 'PSGI';}
+
+use Dancer2;
+use FindBin '$Bin';
+use lib path($Bin, '..', '..', 'lib'), path($Bin, '..', 'lib');
+use Plack::Handler::FCGI;
+use Plack::Util;
+
+# For some reason Apache SetEnv directives dont propagate
+# correctly to the dispatchers, so forcing PSGI and env here
+# is safer.
+set apphandler => 'PSGI';
+set environment => 'production';
+
+my $app = Plack::Util::load_psgi( path($Bin, '..', 'bin', 'query.psgi') );
+die "Unable to read startup script: $@" if $@;
+Plack::Handler::FCGI->new(nproc => 5, detach => 1)->run($app);
--- /dev/null
+#! /usr/bin/env perl
+
+# This means that 'dance' at the end of query.psgi will not start a built in
+# service, but will simply return a coderef. This is useful to run this with
+# diverse dispatchers as well as tests.
+BEGIN { $ENV{DANCER_APPHANDLER} = 'PSGI';}
+
+use strict;
+use warnings;
+use Test::More tests => 12;
+use Plack::Test;
+use Plack::Util;
+use HTTP::Request::Common;
+use FindBin;
+
+# This picks up if this is part of a checkout with OpenSSLQuery
+use if -r $FindBin::Bin.'/../../OpenSSLQuery/lib/OpenSSL/Query.pm',
+ lib => $FindBin::Bin.'/../../OpenSSLQuery/lib';
+
+$ENV{PERSONDB} = $FindBin::Bin.'/query_data/pdb.yaml';
+$ENV{CLADB} = $FindBin::Bin.'/query_data/cdb.txt';
+
+my $app = Plack::Util::load_psgi( $FindBin::Bin.'/../bin/query.psgi' );
+my $test = Plack::Test->create( $app );
+
+subtest 'A empty request' => sub {
+ my $res = $test->request( GET '/' );
+ plan tests => 1;
+ ok( $res->is_error, 'Successfuly failed request' );
+ note( $res->content );
+};
+
+subtest 'A empty Person request' => sub {
+ my $res = $test->request( GET '/0/Person' );
+ plan tests => 1;
+ ok( $res->is_error, 'Successfully failed request' );
+ note( $res->content );
+};
+
+subtest 'Request of person data for Ray Bradbury' => sub {
+ my $res = $test->request( GET '/0/Person/Ray Bradbury' );
+ plan tests => 2;
+ ok( $res->is_success, 'Successful request' );
+ note( $res->content );
+ is( $res->code, 200, 'We have content' );
+};
+
+subtest 'Request of membership for Ray Bradbury' => sub {
+ my $res = $test->request( GET '/0/Person/Ray Bradbury/Membership' );
+ plan tests => 2;
+ ok( $res->is_success, 'Successful request' );
+ note( $res->content );
+ is( $res->code, 200, 'We have content' );
+};
+
+subtest 'Request of membership in specific group for Ray Bradbury' => sub {
+ my $res = $test->request( GET '/0/Person/Ray Bradbury/IsMemberOf/scifi' );
+ plan tests => 2;
+ ok( $res->is_success, 'Successful request' );
+ note( $res->content );
+ is( $res->code, 200, 'We have content' );
+};
+
+subtest 'Request of "author" tag value for Ray Bradbury' => sub {
+ my $res = $test->request( GET '/0/Person/Ray Bradbury/ValueOfTag/author' );
+ plan tests => 2;
+ ok( $res->is_success, 'Successful request' );
+ note( $res->content );
+ is( $res->code, 200, 'We have content' );
+};
+
+subtest 'Request of CLA status for Ray Bradbury' => sub {
+ my $res = $test->request( GET '/0/HasCLA/ray@ourplace.com' );
+ plan tests => 2;
+ ok( $res->is_success, 'Successful request' );
+ note( $res->content );
+ is( $res->code, 200, 'We have content' );
+};
+
+subtest 'Request of person data for Jay Luser' => sub {
+ my $res = $test->request( GET '/0/Person/Jay Luser' );
+ plan tests => 2;
+ ok( $res->is_success, 'Successful request' );
+ note( $res->content );
+ isnt( $res->code, 200, 'We have content' );
+};
+
+subtest 'Request of membership for Jay Luser' => sub {
+ my $res = $test->request( GET '/0/Person/Jay Luser/Membership' );
+ plan tests => 2;
+ ok( $res->is_success, 'Successful request' );
+ note( $res->content );
+ isnt( $res->code, 200, 'We have content' );
+};
+
+subtest 'Request of membership in specific group for Jay Luser' => sub {
+ my $res = $test->request( GET '/0/Person/Jay Luser/IsMemberOf/scifi' );
+ plan tests => 2;
+ ok( $res->is_success, 'Successful request' );
+ note( $res->content );
+ isnt( $res->code, 200, 'We have content' );
+};
+
+subtest 'Request of "author" tag value for Jay Luser' => sub {
+ my $res = $test->request( GET '/0/Person/Jay Luser/ValueOfTag/author' );
+ plan tests => 2;
+ ok( $res->is_success, 'Successful request' );
+ note( $res->content );
+ isnt( $res->code, 200, 'We have content' );
+};
+
+subtest 'Request of CLA status for Jay Luser' => sub {
+ my $res = $test->request( GET '/0/HasCLA/jluser@ourplace.com' );
+ plan tests => 2;
+ ok( $res->is_success, 'Successful request' );
+ note( $res->content );
+ isnt( $res->code, 200, 'We have content' );
+};
+
+1;
--- /dev/null
+ray@ourplace.com I Ray Bradbury
--- /dev/null
+-
+ ids:
+ - Ray Bradbury
+ - Ray
+ - ray@ourplace.com
+ - Burn paper burn
+ memberof:
+ writers: 1950
+ scifi: 1950
+ tags:
+ author: Ray Bradbury <ray@ourplace.com>
projects / tools.git / commitdiff