http[s] tests: Import and slightly hack example script

This is basically a copy of some of the example code from the
HTTP::Server::Simple docs, hacked up with my own (so far) nonsense.

Add copyright info to file and d/copyright.  Upstream licence is
Artistic or GPL-1+.  We choose GPL-1+ and upgrade to GPL-3+.

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>

diff --git a/debian/copyright b/debian/copyright
index 22c9713a950ae3d695328fdf37482b968a32d383..cb3519848323907c90d8d3d0b52dc696c7659a8a 100644 (file)
--- a/debian/copyright
+++ b/debian/copyright
@@ -8,6 +8,7 @@ Copyright (C)2019      Matthew Vernon / Genome Research Limited
 Copyright (C)2019      Paul Hardy
 Copyright (C)1999-2010 Joey Hess
 Copyright (C)2004-2010 Colin Watson
+Copyright (C)2004-2015 Best Practical Solutions, LLC
 
 
 This program is free software: you can redistribute it and/or modify

diff --git a/tests/ftpmasterapi-static-server b/tests/ftpmasterapi-static-server
new file mode 100755 (executable)
index 0000000..a58a8e7
--- /dev/null
+++ b/tests/ftpmasterapi-static-server
@@ -0,0 +1,76 @@
+#!/usr/bin/perl -w
+#
+# This file is part of the dgit test suite.
+#
+# Copyright (C)2004-2015 Best Practical Solutions, LLC
+# Copyright (C)2019      Ian Jackson
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+#
+# invocation:
+#
+#   < tests/tmp/$test/some-file \
+#   ftpmasterapi-static-server \
+#    tests/tmp/
+
+use strict;
+use IO::Handle;
+
+$SIG{ALRM} = sub { print STDERR "y\n"; };
+
+alarm(5);
+
+           package MyServer;
+
+use strict;
+use Socket qw(AF_INET SOCK_STREAM);
+use Socket qw(AF_INET SOCK_STREAM unpack_sockaddr_in);
+use IO::Handle;
+use Data::Dumper;
+
+           use base qw(HTTP::Server::Simple::CGI);
+           use HTTP::Server::Simple::Static;
+
+           my $webroot = '/var/www';
+
+           sub handle_request {
+               my ( $self, $cgi ) = @_;
+
+               if ( !$self->serve_static( $cgi, $webroot ) ) {
+                   print "HTTP/1.0 404 Not found\r\n";
+                   print $cgi->header,
+                         $cgi->start_html('Not found'),
+                         $cgi->h1('Not found'),
+                         $cgi->end_html;
+               }
+           }
+
+sub port () { return 0; }
+
+sub xsetup_listener () 
+{
+my $self=shift;
+print STDERR "foo!", $self->stdio_handle(), "\n";
+my $sock = new IO::Handle;
+socket $sock, AF_INET, SOCK_STREAM, 0 or die $!;
+#$self->stdio_handle($sock);
+}
+
+sub after_setup_listener () {
+my $x = getsockname HTTP::Server::Simple::HTTPDaemon or die $!;
+print STDERR Dumper(unpack_sockaddr_in $x);
+}
+
+           package main;
+
+           my $server = MyServer->new();
+           $server->run();