tests/ftpmasterapi-static-server

   1 #!/usr/bin/perl -w
   2 #
   3 # This file is part of the dgit test suite.
   4 #
   5 # Copyright (C)2004-2015 Best Practical Solutions, LLC
   6 # Copyright (C)2019      Ian Jackson
   7 #
   8 # This program is free software: you can redistribute it and/or modify
   9 # it under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation, either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 #
  18 #
  19 # invocation:
  20 #
  21 #   < tests/tmp/$test/some-file \
  22 #   ftpmasterapi-static-server \
  23 #    tests/tmp/
  24
  25 use strict;
  26 use IO::Handle;
  27
  28 $SIG{ALRM} = sub { print STDERR "y\n"; };
  29
  30 alarm(5);
  31
  32            package MyServer;
  33
  34 use strict;
  35 use Socket qw(AF_INET SOCK_STREAM);
  36 use Socket qw(AF_INET SOCK_STREAM unpack_sockaddr_in);
  37 use IO::Handle;
  38 use Data::Dumper;
  39
  40            use base qw(HTTP::Server::Simple::CGI);
  41            use HTTP::Server::Simple::Static;
  42
  43            my $webroot = '/var/www';
  44
  45            sub handle_request {
  46                my ( $self, $cgi ) = @_;
  47
  48                if ( !$self->serve_static( $cgi, $webroot ) ) {
  49                    print "HTTP/1.0 404 Not found\r\n";
  50                    print $cgi->header,
  51                          $cgi->start_html('Not found'),
  52                          $cgi->h1('Not found'),
  53                          $cgi->end_html;
  54                }
  55            }
  56
  57 sub port () { return 0; }
  58
  59 sub xsetup_listener ()
  60 {
  61 my $self=shift;
  62 print STDERR "foo!", $self->stdio_handle(), "\n";
  63 my $sock = new IO::Handle;
  64 socket $sock, AF_INET, SOCK_STREAM, 0 or die $!;
  65 #$self->stdio_handle($sock);
  66 }
  67
  68 sub after_setup_listener () {
  69 my $x = getsockname HTTP::Server::Simple::HTTPDaemon or die $!;
  70 print STDERR Dumper(unpack_sockaddr_in $x);
  71 }
  72
  73            package main;
  74
  75            my $server = MyServer->new();
  76            $server->run();