]> git.proxmox.com Git - pve-http-server.git/commitdiff
move simple-demo.pl -> examples/simple-demo.pl
authorDietmar Maurer <dietmar@proxmox.com>
Sat, 21 Jan 2017 14:48:04 +0000 (15:48 +0100)
committerDietmar Maurer <dietmar@proxmox.com>
Sat, 21 Jan 2017 14:48:04 +0000 (15:48 +0100)
Makefile
examples/simple-demo.pl [new file with mode: 0755]
simple-demo.pl [deleted file]

index 743ab15fd991d854f4c59bdc692eac6aef7f84f9..f6d7f0f41e6f37bcc67d1a8424d0676149bcfff9 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -77,10 +77,10 @@ upload: ${DEB}
        tar cf - ${DEB} | ssh repoman@repo.proxmox.com upload
 
 distclean: clean
-       rm -f simple-demo.pem
+       rm -f examples/simple-demo.pem
 
 clean:
-       rm -rf ./build *.deb *.changes ${BTDIR} simple-demo.lck
+       rm -rf ./build *.deb *.changes ${BTDIR} examples/simple-demo.lck
        find . -name '*~' -exec rm {} ';'
 
 .PHONY: dinstall
diff --git a/examples/simple-demo.pl b/examples/simple-demo.pl
new file mode 100755 (executable)
index 0000000..886c636
--- /dev/null
@@ -0,0 +1,195 @@
+#!/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();
diff --git a/simple-demo.pl b/simple-demo.pl
deleted file mode 100755 (executable)
index 886c636..0000000
+++ /dev/null
@@ -1,195 +0,0 @@
-#!/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();