[pve-http-server.git] / simple-demo.pl

#!/usr/bin/perl

package DemoServer;

use strict;
use warnings;
use HTTP::Status qw(:constants);
use URI::Escape;

use PVE::APIServer::AnyEvent;
use PVE::Exception qw(raise_param_exc);

use base('PVE::APIServer::AnyEvent');

use Digest::MD5;

my $secret = Digest::MD5::md5_base64($$ . time());

sub create_ticket {
    my ($username) = @_;

    my $salt = sprintf("%08x", time());
    my $data = "$username:$salt";
    my $sig = Digest::MD5::md5_base64("$data:$secret");
    return "$username:$salt:$sig";
}

sub verify_ticket {
    my ($ticket) = @_;

    die "no ticket" if !defined($ticket);
    my ($userid, $salt, $rest) = split(/:/, $ticket, 3);

    die "invalid ticket" if !defined($salt) || !defined($rest);

    die "invalid unsername" if $userid ne 'demo';

    my $sig = Digest::MD5::md5_base64("$userid:$salt:$secret");

    die "invalid ticket" if $rest ne $sig;

    return $userid;
}

sub auth_handler {
    my ($self, $method, $rel_uri, $ticket, $token, $peer_host) = @_;

    # explicitly allow some calls without authentication
    if ($rel_uri eq '/access/ticket' && 
	($method eq 'POST' || $method eq 'GET')) {
	return; # allow call to create ticket
    }

    my $userid = verify_ticket($ticket);

    return {
	ticket => $ticket,
	userid => $userid,
    };    
}

sub rest_handler {
    my ($self, $clientip, $method, $rel_uri, $auth, $params) = @_;

    my $resp = {
	status => HTTP_NOT_IMPLEMENTED,
	message => "Method '$method $rel_uri' not implemented",
    };
    if ($rel_uri eq '/access/ticket') {
	if ($method eq 'POST') {
	    if ($params->{username} && $params->{username} eq 'demo' &&
		$params->{password} && $params->{password} eq 'demo') {
		return {
		    status => HTTP_OK,
		    data => {
			ticket => create_ticket($params->{username}),
		    },
		};
	    }
	    return $resp;
	} elsif ($method eq 'GET') {
	    # this is allowed to display the login form
	    return { status => HTTP_OK, data => {} };
	} else {
	    return $resp;
	}
    }
    
    $resp = {
	data => {
	    method => $method,
	    clientip => $clientip,
	    rel_uri =>  $rel_uri,
	    auth => $auth,
	    params => $params,
	},
	info => { description => "You called API method '$method $rel_uri'" },
	status => HTTP_OK,
    };

    return $resp;
}


package main;

use strict;
use warnings;

use Socket qw(IPPROTO_TCP TCP_NODELAY SOMAXCONN);
use IO::Socket::IP;
use HTTP::Headers;
use HTTP::Response;

use PVE::Tools qw(run_command);
use PVE::INotify;
use PVE::APIServer::Formatter::Standard;
use PVE::APIServer::Formatter::HTML;

my $nodename = PVE::INotify::nodename();
my $port = 9999;

my $cert_file = "simple-demo.pem";

if (! -f $cert_file) {
    print "generating demo server certificate\n";
    my $cmd = ['openssl', 'req', '-batch', '-x509', '-newkey', 'rsa:4096',
	       '-nodes', '-keyout', $cert_file, '-out', $cert_file,
	       '-subj', "/CN=$nodename/",
	       '-days', '3650'];
    run_command($cmd);
}

my $socket = IO::Socket::IP->new(
    LocalAddr => $nodename,
    LocalPort => $port,
    Listen => SOMAXCONN,
    Proto  => 'tcp',
    GetAddrInfoFlags => 0,
    ReuseAddr => 1) ||
    die "unable to create socket - $@\n";

# we often observe delays when using Nagle algorithm,
# so we disable that to maximize performance
setsockopt($socket, IPPROTO_TCP, TCP_NODELAY, 1);

my $accept_lock_fn = "simple-demo.lck";
my $lockfh = IO::File->new(">>${accept_lock_fn}") ||
    die "unable to open lock file '${accept_lock_fn}' - $!\n";

my $server = DemoServer->new(
    socket => $socket,
    lockfile => $accept_lock_fn,
    lockfh => $lockfh,
    title => 'Simple Demo API',
    logfh => \*STDOUT,
    tls_ctx  => { verify => 0, cert_file => $cert_file },
    pages => {
	'/' => sub { get_index($nodename, @_) },
    },
);

# NOTE: Requests to non-API pages are not authenticated
# so you must be very careful here

my $root_page = <<__EOD__;
<!DOCTYPE html>
<html>
  <head>
    <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
    <meta http-equiv="X-UA-Compatible" content="IE=edge">
    <meta name="viewport" content="width=device-width, initial-scale=1, maximum-scale=1, user-scalable=no">
    <title>Simple Demo Server</title>
  </head>
  <body>
    <h1>Simple Demo Server ($nodename)</h1>

    You can browse the API <a href='/api2/html' >here</a>. Please sign
    in with usrename <b>demo</b> and passwort <b>demo</b>.

  </body>
</html>
__EOD__
    
sub get_index {
    my ($nodename, $server, $r, $args) = @_;

    my $headers = HTTP::Headers->new(Content_Type => "text/html; charset=utf-8");
    my $resp = HTTP::Response->new(200, "OK", $headers, $root_page);

}

print "demo server listens at: https://$nodename:$port/\n";

$server->run();
Commit	Line	Data
e4718189 DM	1	#!/usr/bin/perl
	2
	3	package DemoServer;
	4
	5	use strict;
	6	use warnings;
	7	use HTTP::Status qw(:constants);
	8	use URI::Escape;
	9
	10	use PVE::APIServer::AnyEvent;
	11	use PVE::Exception qw(raise_param_exc);
	12
	13	use base('PVE::APIServer::AnyEvent');
	14
	15	use Digest::MD5;
	16
	17	my $secret = Digest::MD5::md5_base64($$ . time());
	18
	19	sub create_ticket {
	20	my ($username) = @_;
	21
84df857f DM	22	my $salt = sprintf("%08x", time());
	23	my $data = "$username:$salt";
	24	my $sig = Digest::MD5::md5_base64("$data:$secret");
	25	return "$username:$salt:$sig";
	26	}
	27
	28	sub verify_ticket {
	29	my ($ticket) = @_;
	30
	31	die "no ticket" if !defined($ticket);
	32	my ($userid, $salt, $rest) = split(/:/, $ticket, 3);
	33
	34	die "invalid ticket" if !defined($salt) \|\| !defined($rest);
	35
	36	die "invalid unsername" if $userid ne 'demo';
	37
	38	my $sig = Digest::MD5::md5_base64("$userid:$salt:$secret");
	39
	40	die "invalid ticket" if $rest ne $sig;
	41
	42	return $userid;
e4718189 DM	43	}
	44
	45	sub auth_handler {
	46	my ($self, $method, $rel_uri, $ticket, $token, $peer_host) = @_;
	47
	48	# explicitly allow some calls without authentication
	49	if ($rel_uri eq '/access/ticket' &&
	50	($method eq 'POST' \|\| $method eq 'GET')) {
	51	return; # allow call to create ticket
	52	}
	53
84df857f	54	my $userid = verify_ticket($ticket);
e4718189	55
e4718189 DM	56	return {
	57	ticket => $ticket,
	58	userid => $userid,
	59	};
	60	}
	61
	62	sub rest_handler {
	63	my ($self, $clientip, $method, $rel_uri, $auth, $params) = @_;
	64
	65	my $resp = {
	66	status => HTTP_NOT_IMPLEMENTED,
	67	message => "Method '$method $rel_uri' not implemented",
	68	};
	69	if ($rel_uri eq '/access/ticket') {
	70	if ($method eq 'POST') {
	71	if ($params->{username} && $params->{username} eq 'demo' &&
	72	$params->{password} && $params->{password} eq 'demo') {
	73	return {
	74	status => HTTP_OK,
	75	data => {
	76	ticket => create_ticket($params->{username}),
	77	},
	78	};
	79	}
	80	return $resp;
	81	} elsif ($method eq 'GET') {
	82	# this is allowed to display the login form
	83	return { status => HTTP_OK, data => {} };
	84	} else {
	85	return $resp;
	86	}
	87	}
	88
	89	$resp = {
	90	data => {
	91	method => $method,
	92	clientip => $clientip,
	93	rel_uri => $rel_uri,
	94	auth => $auth,
	95	params => $params,
	96	},
	97	info => { description => "You called API method '$method $rel_uri'" },
	98	status => HTTP_OK,
	99	};
	100
	101	return $resp;
	102	}
	103
	104
	105	package main;
	106
	107	use strict;
	108	use warnings;
	109
	110	use Socket qw(IPPROTO_TCP TCP_NODELAY SOMAXCONN);
	111	use IO::Socket::IP;
	112	use HTTP::Headers;
	113	use HTTP::Response;
	114
	115	use PVE::Tools qw(run_command);
	116	use PVE::INotify;
	117	use PVE::APIServer::Formatter::Standard;
	118	use PVE::APIServer::Formatter::HTML;
	119
120	my $nodename = PVE::INotify::nodename();
121	my $port = 9999;
122
1111604c DM	123	my $cert_file = "simple-demo.pem";
	124
	125	if (! -f $cert_file) {
e4718189	126	print "generating demo server certificate\n";
1111604c DM	127	my $cmd = ['openssl', 'req', '-batch', '-x509', '-newkey', 'rsa:4096',
1111604c DM	128	'-nodes', '-keyout', $cert_file, '-out', $cert_file,
c67d07fc	129	'-subj', "/CN=$nodename/",
1111604c	130	'-days', '3650'];
e4718189 DM	131	run_command($cmd);
	132	}
	133
	134	my $socket = IO::Socket::IP->new(
	135	LocalAddr => $nodename,
	136	LocalPort => $port,
	137	Listen => SOMAXCONN,
	138	Proto => 'tcp',
	139	GetAddrInfoFlags => 0,
	140	ReuseAddr => 1) \|\|
	141	die "unable to create socket - $@\n";
	142
	143	# we often observe delays when using Nagle algorithm,
	144	# so we disable that to maximize performance
	145	setsockopt($socket, IPPROTO_TCP, TCP_NODELAY, 1);
	146
	147	my $accept_lock_fn = "simple-demo.lck";
	148	my $lockfh = IO::File->new(">>${accept_lock_fn}") \|\|
	149	die "unable to open lock file '${accept_lock_fn}' - $!\n";
	150
	151	my $server = DemoServer->new(
	152	socket => $socket,
	153	lockfile => $accept_lock_fn,
	154	lockfh => $lockfh,
	155	title => 'Simple Demo API',
	156	logfh => \*STDOUT,
1111604c	157	tls_ctx => { verify => 0, cert_file => $cert_file },
e4718189 DM	158	pages => {
	159	'/' => sub { get_index($nodename, @_) },
	160	},
	161	);
	162
	163	# NOTE: Requests to non-API pages are not authenticated
	164	# so you must be very careful here
	165
	166	my $root_page = <<__EOD__;
	167	<!DOCTYPE html>
	168	<html>
	169	<head>
	170	<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
	171	<meta http-equiv="X-UA-Compatible" content="IE=edge">
	172	<meta name="viewport" content="width=device-width, initial-scale=1, maximum-scale=1, user-scalable=no">
	173	<title>Simple Demo Server</title>
	174	</head>
	175	<body>
	176	<h1>Simple Demo Server ($nodename)</h1>
	177
	178	You can browse the API <a href='/api2/html' >here</a>. Please sign
	179	in with usrename <b>demo</b> and passwort <b>demo</b>.
	180
	181	</body>
	182	</html>
	183	__EOD__
	184
	185	sub get_index {
	186	my ($nodename, $server, $r, $args) = @_;
	187
	188	my $headers = HTTP::Headers->new(Content_Type => "text/html; charset=utf-8");
	189	my $resp = HTTP::Response->new(200, "OK", $headers, $root_page);
	190
	191	}
	192
	193	print "demo server listens at: https://$nodename:$port/\n";
	194
	195	$server->run();