wi12.unix7.org

This small application was planned to use for authentication service about 1200 users on 8 application servers.

I refused this decision because this work will not be paid to me Nevertheless it is good working even in this beta stage. To add functionally, you only need to add your code/methods to aRPC object (see main code below).

I wrote this micro-framework for old (old-old) legacy operating system. I used minimum of third-party modules. And as it turned out, the application works well even on OpenWRT/LEDE Linux with its 24 mb memory

• jrpcd-0.01.tar.gz

# tar xzf jrpcd-0.01.tar.gz
# cd jrpcd-0.01
# ./configure --prefix=/usr/local
# make install
# cd /usr/local/etc/jrpcd
# cp jrpcd.crt.example jrpcd.crt
# cp jrpcd.key.example jrpcd.key
# cp jrpcd.pw.example jrpcd.pw

Depend of kind your operation system

# systemctl start jrpcd

or

# service jrpcd start

# curl -k --data-binary '{"id":1,"jsonrpc":"2.0","method":"hello","params":"John"}' \
    -H 'Content-type: application/json;' https://master:password@app.example.com:4431/rpc
{"jsonrpc":"2.0","id":1,"result":"Hi, John!"}
 
# curl -k --data-binary '{"id":1,"jsonrpc":"2.0","method":"auth","params":["John","password"]}' \
    -H 'Content-type: application/json;' https://master:password@app.example.com:4431/rpc
{"jsonrpc":"2.0","id":1,"result":{"auth":1,"message":""}}
 
# curl -k --data-binary '{"id":1,"jsonrpc":"2.0","method":"auth","params":["John","bad_password"]}' \
    -H 'Content-type: application/json;' https://master:password@app.example.com:4431/rpc
{"jsonrpc":"2.0","id":1,"result":{"auth":0,"message":"Bad password!"}}

jrpcd.pl.in

#!@perl@
 
#------------
#--- HTTP ---
#------------
 
package aDaemon;
 
use strict;
use warnings;
use threads;
use POSIX qw(strftime getpid setuid setgid geteuid getegid);
use Scalar::Util qw(blessed);
use JSON::PP qw(encode_json decode_json);
use MIME::Base64 qw(decode_base64 encode_base64);
use HTTP::Daemon::SSL;
use HTTP::Status;
 
sub new {
    my ($class, $port, $cert, $key) = @_;
    my $httpd = HTTP::Daemon::SSL->new(
        Reuse => 1,
        SSL_cert_file => $cert,
        SSL_key_file => $key,
        LocalAddr => '0.0.0.0',
        LocalPort => $port,
        Listen => 10,
        SSL_server => 1,
#        SSL_keepSocketOnError => 1,
    );
    my $self = {
        httpd => $httpd,
        route => {},
        config => {
            logfile => '/dev/null',
            pidfile => '/dev/null',
            pwfile => '/dev/null',
            certfile => undef,
            keyfile => undef,
            user => undef,
            group => undef
        }
    };
    bless $self, $class;
    return $self;
}
 
sub httpd {
    my ($self, $httpd) = @_;
    return $self->{httpd} unless $httpd;
    $self->{httpd} = $httpd;
    $self;
}
 
sub config {
    my ($self, $key, $value) = @_;
    return $self->{config} unless $key;
    return $self->{config}->{$key} unless $value;
    $self->{config}->{$key} = $value;
    $self;
}
 
sub route {
    my ($self, $route, $class, $method) = @_;
    unless ($class and $method) {
        return $self->{routes}->{$route};
    }
    $self->{routes}->{$route}->{class} = $class;
    $self->{routes}->{$route}->{method} = $method;
    $self;
}
 
sub run {
    my $self = shift;
    # it's workaround http:// request
    while (1) {
        while (my $c = $self->httpd->accept) {
            # openssl library not thread-safe =( 
            # my $class = blessed $self;
            # threads->create(\&handler, $self, $c)->detach;
            my $pid = fork;
            if ($pid == 0) {
                $self->handler($c);
            }
        }
    }
}
 
sub fork {
    my $self = shift;
 
    my $pid = fork;
    if ($pid > 0) {
        exit;
    }
    chdir("/");
 
    my $user = $self->config('user');
    my $group = $self->config('group');
    my $uid = getpwnam($user) if $user;
    my $gid = getgrnam($group) if $group;
 
    setuid($uid) if $uid;
    setgid($gid) if $gid;
 
    open(my $stdout, '>&', STDOUT); 
    open(my $stderr, '>&', STDERR);
 
    open(STDOUT, '>>', '/dev/null');
    open(STDERR, '>>', '/dev/null');
    getpid;
}
 
sub writepid {
    my $self = shift;
    my $pidfile = $self->config('pidfile');
    return undef unless $pidfile;
    open my $fh, '>', $pidfile or return undef;
    print $fh getpid;
    close $fh;
}
 
sub log {
    my ($self, $message) = @_;
    my $timestamp = strftime("%Y-%m-%d %H:%M:%S %Z", localtime(time));
    print "$timestamp $message\n";
 
    my $logfile = $self->config('logfile');
    open my $fh, '>>', $logfile or return undef;
    print $fh "$timestamp $message\n";
    close $fh;
}
 
sub handler {
    my ($self, $c) = @_;
    my $req = $c->get_request;
 
    #### logger ####
    my $peer_addr = $c->peerhost;
    my $uri = $req->uri;
    my $method = $req->method;
    my $host = $req->header('Host');
 
    ### authorization ###
    my $basic = $req->header('Authorization') || '';
 
    unless ($basic =~ m/Basic /) {
        $self->log("$peer_addr $method $host$uri unauth:undef");
        $c->send_error(RC_UNAUTHORIZED);
        $c->close;
        return;
    };
 
    my ($pair) = $basic =~ m/\w+\s+(\w+)/;
    my ($login, $password) = split(':', decode_base64($pair));
 
    unless ($self->auth($login, $password)) {
        $self->log("$peer_addr $method $host$uri unauth:$login");
        $c->send_error(RC_UNAUTHORIZED);
        $c->close;
        return;
    };
 
    my $content = $req->content;
 
    $self->log("$peer_addr $method $host$uri $login $content");
 
    #### router ####
    my $path = $req->uri->path;
 
    my $p = $self->route($path);
    my $class = $p->{class};
    my $subr = $p->{method};
 
    if ($class and $subr) {
 
        my $obj = $class->new;
        my $res = $obj->$subr($content);
 
        $c->send_basic_header;
        $c->print("Content-Type: application/json");
        $c->send_crlf;
        $c->send_crlf;
        $c->print($res);
    } else {
        $c->send_error(RC_NOT_FOUND);
    }
    $c->close;
    undef($c);
}
 
sub auth {
    my ($self, $name, $password) = @_;
    return undef unless $self->config('pwfile');
    return undef unless $name and $password;
 
    open my $fh, '<', $self->config('pwfile') or return undef;
 
    while (my $line = readline $fh) {
        chomp $line;
        my ($login, $hash, $gecos) = split ':', $line;
        next unless $hash;
        next if $login ne $name;
 
        my ($dummy, $type, $salt, $sum) = split '\$', $hash;
        next unless $salt;
        next unless $sum;
 
        my $new_hash;
        $new_hash = crypt($password, "\$$type\$$salt\$");
        return 1 if $hash eq $new_hash;
    }
    close $fh;
    undef;
}
 
1;
 
#-----------
#--- RPC ---
#-----------
 
package aRPC;
 
use strict;
use warnings;
use JSON::PP qw(encode_json decode_json);
use MIME::Base64 qw(decode_base64 encode_base64);
use Scalar::Util qw(reftype);
 
use SOAP::Lite;
 
sub new {
    my $class = shift;
    my $self = {
    };
    bless $self, $class;
    return $self;
}
 
sub run {
    my ($self, $content) = @_;
 
    my $req;
    eval { $req = decode_json($content); };
    my $err = $@;
    if ($err) {
        my $body = {
            jsonrpc => '2.0',
            error => {
                code => -32700,
                message => 'Parse error',
                data => $@
            },
            id => undef
        };
        return encode_json($body);
    }
 
    my $method = $req->{method};
    my $params = $req->{params};
    my $id = $req->{id};
 
    my $res;
 
    unless (reftype $params) {
        eval { $res = $self->$method($params); };
        $err = $@;
    } elsif (reftype $params eq 'ARRAY') {
        eval { $res =  $self->$method(@{$params}); };
        $err = $@;
    } elsif (reftype $params eq 'HASH') {
        eval { $res =  $self->$method(%{$params}); };
        $err = $@;
    };
 
    my $body;
    unless ($err) {
        $body = {
            jsonrpc => '2.0',
            result => $res,
            id => $id
        };
    } else {
        $body = {
            jsonrpc => '2.0',
            error => {
                code => -32601,
                message => 'Method not found',
                data => $@
            },
            id => $id
        };
    }
    encode_json($body);
}
 
sub hello {
    my ($self, $name) = @_;
    $name ||= 'Body';
    "Hi, $name!";
}
 
 
sub list {
    my $res = SOAP::Lite 
        -> uri('http://v8.1c.ru/8.1/data/core')
        -> proxy('http://login:password@app.example.com/ws/Auth')
        -> GetUsersList
        -> result;
    $res->{Value};
}
 
sub auth {
    my ($self, $login, $password) = @_;
 
    my $soap = SOAP::Lite
        ->uri('http://v8.1c.ru/8.1/data/core')
        ->proxy('http://login:password@app.example.com/ws/Auth');
 
    my @params = (
            SOAP::Data->name(UserName => $login)->type('string'),
            SOAP::Data->name(UserPassword => $password)->type('string'),
    );
 
    my $res = $soap->UserAuth(@params)->result;
    my $auth = $res->{Property}->[0]->{Value};
    my $message = $res->{Property}->[1]->{Value};
 
    { auth => $auth, message => $message };
}
 
 
1;
 
use strict;
use warnings;
use Mojo::Util qw(dumper);
use Getopt::Std;
 
my $options = {};
 
getopts("fh", $options);
 
if ($options->{h}) {
    print "Usage: \n";
    print "  -f No fork\n";
    print "  -h Print this help\n";
    exit;
}
 
my $cert = '@app_confdir@/jrpcd.crt';
my $key = '@app_confdir@/jrpcd.key';
 
my $daemon = aDaemon->new(4431, $cert, $key);
 
$daemon->config(pwfile => '@app_confdir@/jrpcd.pw');
$daemon->config(pidfile => '@app_rundir@/jrpcd.pid');
$daemon->config(logfile => '@app_logdir@/jrpcd.log');
$daemon->config(user => '@app_user@');
$daemon->config(group => '@app_group@');
 
$daemon->route('/rpc', aRPC => 'run');
$daemon->log('start application');
$daemon->fork unless $options->{f};
$daemon->writepid;
$daemon->run;
#EOF