simple-demo.pl

   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
  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;
  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
  54     my $userid = verify_ticket($ticket);
  55
  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
 123 my $cert_file = "simple-demo.pem";
 124
 125 if (! -f $cert_file) {
 126     print "generating demo server certificate\n";
 127     my $cmd = ['openssl', 'req', '-batch', '-x509', '-newkey', 'rsa:4096',
 128                '-nodes', '-keyout', $cert_file, '-out', $cert_file,
 129                '-subj', "/CN=$nodename/",
 130                '-days', '3650'];
 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,
 157     tls_ctx  => { verify => 0, cert_file => $cert_file },
 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();