From 083b1fd54624a7b3fc580fc595b46a958dd726b0 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Thu, 25 Jul 2019 01:30:33 +0100 Subject: [PATCH] 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 --- debian/copyright | 1 + tests/ftpmasterapi-static-server | 76 ++++++++++++++++++++++++++++++++ 2 files changed, 77 insertions(+) create mode 100755 tests/ftpmasterapi-static-server diff --git a/debian/copyright b/debian/copyright index 22c9713a..cb351984 100644 --- 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 index 00000000..a58a8e73 --- /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(); -- 2.30.2