1

我正在开发一个 adhoc GUI，以便我可以轻松地查看来自 VMWare Perl SDK 的一堆数据，而无需在 IIS 下设置一堆脚本。基本思想是启动脚本，并让它分叉两个进程。一个是 HTTP::Daemon Web 服务器，两秒后是 Win32::IEAutomation 运行浏览器。我承认这并不漂亮，但我对 VMPerlSDK 比对 VMCOMSDK 更满意。另外，我很想知道我是否可以使它起作用。

据我所知，程序启动正常。叉子工作。小 URI 解析器工作。唯一的问题是每当我尝试调用 /quit 来关闭服务器时，脚本就会爆炸。

任何建议（除了应该如何使用 IIS 和 AutoIT，我知道，我知道）将不胜感激。谢谢！

#!/usr/bin/perl -w
use Data::Dumper;
use HTTP::Daemon;
use HTTP::Status;
use HTTP::Response;
use strict;
use warnings;
use Win32::IEAutomation;

sub MainPage {
    return<<eol
<html>
<head><title>Test</title></head>
<body>
<h3>Home</h3>
<p><a href="/quit">Quit</a></p>
</body>
</html>
eol
}

# Parses out web variables
sub WebParse {
    my ($wstring) = @_;
    my %webs = ();
    # gets key/value data
    my @pairs = split(/&/, $wstring);

    # puts the key name into an array
    foreach my $pair (@pairs) {
            my ($kname, $kval) = split (/=/, $pair);
            $kval =~ tr/+/ /;
            $kval =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
            $webs{$kname} = $kval;
    }

    return(%webs);
}

sub StartServer {
    my $PORT = shift;
    my $ALLOWED = shift;

    my $d = HTTP::Daemon->new(ReuseAddr => 1, LocalAddr => $ALLOWED, LocalPort => $PORT) || die;

    # Prints a startup message
    print "Please contact me at: <URL:", $d->url, ">\n";
    my $xt = 0;

    BLOOP: while (my $c = $d->accept) {
        while (my $r = $c->get_request) {
            # Handles requests with the GET or POST methods
            if ($r->method =~ m/GET/i || $r->method =~ m/POST/i) {
                my $uri = $r->uri; my %ENV = ();

                $ENV{REQUEST_METHOD} = $r->method;
                $ENV{CONTENT_TYPE}   = join('; ', $r->content_type);
                $ENV{CONTENT_LENGTH} = $r->content_length || '';
                $ENV{SCRIPT_NAME}    = $uri->path || 1;
                $ENV{REMOTE_ADDR}    = $c->peerhost();

                if ($r->method =~ m/GET/i) {
                    $ENV{QUERY_STRING}   = $uri->query || '';
                }
                elsif ($r->method =~ m/POST/i) {
                    $ENV{QUERY_STRING}   = $r->{"_content"} || '';
                }

                my %q = &WebParse($ENV{QUERY_STRING});

                my $res = HTTP::Response->new("200");

                if ($uri =~ m/quit/i) {
                    $res->content("Goodbye");
                    $xt=1;
                }
                else {
                    $res->content(MainPage());
                }

                $c->send_response($res);
            }
            # Otherwise
            else {
                $c->send_error("This server only accepts GET or POST methods");
            }

            if ($xt == 1) {
                sleep(2);
                $c->force_last_request();
                last BLOOP;
            }

            $c->close;
        }
        undef($c);
    }
    $d->close;
    undef($d);
    exit;
}

sub StartInterface {
    my $PORT = shift;
    my $ALLOWED = shift;
    my $ie = Win32::IEAutomation->new(visible => 1, maximize => 1);
    $ie->gotoURL("http://".$ALLOWED.":".$PORT."/");
    exit;
}

# Return Status
my $STATUS = 1;

# Server port number
my $PORT = 9005;

# The server that's allowed to talk to this one
my $ALLOWED = "127.0.0.1";

my $pid = fork();

if ($pid == 0) {
    StartServer($PORT, $ALLOWED);
} else {
    sleep(2);
    StartInterface($PORT, $ALLOWED);
}

exit;
4

1 回答 1

0

在你关闭你的守护进程 $d 之前，关闭套接字并告诉父 pid 退出：

$d->shutdown(2);
$d->close;
undef $d;
kill(2,getppid());
exit;
于 2018-06-15T20:27:39.857 回答