From 6907585cf10bf56cc1d1124a6a909956c31e4139 Mon Sep 17 00:00:00 2001
From: Pascal Rigaux <pixel@mandriva.com>
Date: Tue, 7 Aug 2001 19:42:58 +0000
Subject: add interactive_http

---
 .../interactive_http/interactive_http.cgi          | 92 ++++++++++++++++++++++
 1 file changed, 92 insertions(+)
 create mode 100755 perl-install/standalone/interactive_http/interactive_http.cgi

(limited to 'perl-install/standalone/interactive_http/interactive_http.cgi')

diff --git a/perl-install/standalone/interactive_http/interactive_http.cgi b/perl-install/standalone/interactive_http/interactive_http.cgi
new file mode 100755
index 000000000..cb184300a
--- /dev/null
+++ b/perl-install/standalone/interactive_http/interactive_http.cgi
@@ -0,0 +1,92 @@
+#!/usr/bin/perl
+
+use lib qw(/usr/lib/libDrakX);
+use CGI;
+use common;
+use c;
+
+my $q = CGI->new;
+$| = 1;
+
+my $script_name = $q->url(-relative => 1);
+
+# name inversed (must be in sync with interactive_http.html)
+my $pipe_r = "/tmp/interactive_http_w";
+my $pipe_w = "/tmp/interactive_http_r";
+
+if ($q->param('state') eq 'new') {
+    force_exit_dead_prog();
+    mkfifo($pipe_r); mkfifo($pipe_w);
+
+    spawn_server($q->param('prog'));
+    first_step();
+
+} elsif ($q->param('state') eq 'next_step') {
+    next_step();
+} else {
+    error("booh...");
+}
+
+sub read_ {
+    local *F;
+    open F, "<$pipe_r" or error("Failed to connect to the prog");
+    my $t;
+    print $t while sysread F, $t, 1;
+}
+sub write_ {
+    local *F;
+    open F, ">$pipe_w" or die;
+    my $q = CGI->new;
+    $q->save(\*F);
+}
+
+sub first_step { read_() }
+sub next_step { write_(); read_() }
+
+
+sub force_exit_dead_prog {
+    -p $pipe_w or return;
+    {
+	local *F;
+	sysopen F, $pipe_w, 1 | c::O_NONBLOCK() or return;
+	syswrite F, "force_exit_dead_prog=1\n";
+    }
+
+    my $cnt = 10;
+    while (-p $pipe_w) {
+	sleep 1;
+	$cnt-- or error("Dead prog failed to exit");
+    }
+}
+
+sub spawn_server {
+    my ($prog) = @_;
+
+    fork and return;
+
+    $ENV{INTERACTIVE_HTTP} = $script_name;
+
+    open STDIN, "</dev/zero";
+    open STDOUT, ">/dev/null"; #tmp/log";
+    open STDERR, ">&STDOUT";
+
+    c::setsid();
+    exec $prog or die "prog $prog not found\n";
+}
+
+sub error {
+    my $msg = join '', @_;
+
+    print $q->header(), $q->start_html();
+    print $q->h1(_("Error")), @_;
+    print $q->end_html(), "\n";
+    exit 0;
+}
+
+sub mkfifo {
+    my ($f) = @_;
+    -p $f and return;
+    unlink $f;
+    syscall_('mknod', $f, c::S_IFIFO() | 0600, 0) or die "mkfifo failed";
+    chmod 0666, $f;
+}
-- 
cgit v1.2.1