add interactive_http

7 files changed, 186 insertions, 8 deletions

diff --git a/perl-install/standalone/interactive_http/Makefile b/perl-install/standalone/interactive_http/Makefile
new file mode 100644
index 000000000..535d06d99
--- /dev/null
+++ b/perl-install/standalone/interactive_http/Makefile
@@ -0,0 +1,16 @@
+NAME=libDrakX
+FNAME=$(NAME)/drakxtools_http
+PREFIX=
+DATADIR=$(PREFIX)/usr/share
+
+all:
+
+install:	
+	install -D miniserv.init $(PREFIX)/etc/init.d/drakxtools_http
+	install -D -m 644 miniserv.conf $(PREFIX)/etc/drakxtools_http.conf
+	install -D -m 644 miniserv.pam $(PREFIX)/etc/pam.d/miniserv
+
+	install -d $(DATADIR)/$(FNAME)/www
+	install -m 644 miniserv.pl miniserv.pem miniserv.users $(DATADIR)/$(FNAME)
+	install -m 644 index.html $(DATADIR)/$(FNAME)/www
+	install interactive_http.cgi $(DATADIR)/$(FNAME)/www
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;
+}
diff --git a/perl-install/standalone/interactive_http/miniserv.conf b/perl-install/standalone/interactive_http/miniserv.conf
new file mode 100644
index 000000000..99f6a5172
--- /dev/null
+++ b/perl-install/standalone/interactive_http/miniserv.conf
@@ -0,0 +1,13 @@
+ssl=1
+log=1
+port=10001
+listen=10001
+forkcgis=1
+realm=Drakxtools Server
+
+addtype_cgi=internal/cgi
+logfile=/var/log/drakxtools_http.log
+pidfile=/var/run/drakxtools_http.pid
+root=/usr/share/libDrakX/drakxtools_http/www
+keyfile=/usr/share/libDrakX/drakxtools_http/miniserv.pem
+userfile=/usr/share/libDrakX/drakxtools_http/miniserv.users
diff --git a/perl-install/standalone/interactive_http/miniserv.init b/perl-install/standalone/interactive_http/miniserv.init
new file mode 100644
index 000000000..39c724dc7
--- /dev/null
+++ b/perl-install/standalone/interactive_http/miniserv.init
@@ -0,0 +1,51 @@
+#!/bin/sh
+# chkconfig: 235 99 00
+# description: Start or stop the miniserv administration server
+
+name=drakxtools_http
+server=/usr/share/libDrakX/$name/miniserv.pl
+
+case "$1" in
+'start')
+	echo -n "Starting $name: "
+	perl $server /etc/$name.conf
+	touch /var/lock/subsys/drakxtools_http
+	echo $name
+	;;
+'stop')
+	echo -n "Shutting down $name: "
+	kill `cat /var/run/$name.pid`
+	rm -f /var/lock/subsys/drakxtools_http
+	echo $name
+	;;
+'status')
+	if [ -s /var/run/$name.pid ]; then
+	    pid=`cat /var/run/$name.pid`
+		kill -0 $pid >/dev/null 2>&1
+		if [ "$?" = "0" ]; then
+			echo "$name (pid $pid) is running"
+		else
+			echo "$name is stopped"
+		fi
+	else
+		echo "$name is stopped"
+	fi
+	;;
+'restart')
+	$0 stop
+	$0 start
+	;;
+'reload')
+        $0 stop
+        $0 start
+        ;;
+'condrestart')
+	if [ -f /var/lock/subsys/drakxtools_http ]; then
+            $0 restart
+        fi
+        ;;
+*)
+	echo "Usage: $0 {start|stop|restart|status|reload|condrestart}"
+	;;
+esac
+exit 0
diff --git a/perl-install/standalone/interactive_http/miniserv.pam b/perl-install/standalone/interactive_http/miniserv.pam
new file mode 100644
index 000000000..37eae44e0
--- /dev/null
+++ b/perl-install/standalone/interactive_http/miniserv.pam
@@ -0,0 +1,5 @@
+#%PAM-1.0
+auth       required	/lib/security/pam_stack.so service=system-auth
+account    required	/lib/security/pam_stack.so service=system-auth
+password   required	/lib/security/pam_stack.so service=system-auth
+session    required	/lib/security/pam_stack.so service=system-auth
diff --git a/perl-install/standalone/interactive_http/miniserv.pl b/perl-install/standalone/interactive_http/miniserv.pl
index f866ee81a..b11ce26e2 100644
--- a/perl-install/standalone/interactive_http/miniserv.pl
+++ b/perl-install/standalone/interactive_http/miniserv.pl
@@ -58,7 +58,7 @@ if ($config{'syslog'}) {
 eval "use Authen::PAM";
 if (!$@) {
 	# check if the PAM authentication can be used by opening a handle
-	if (! ref($pamh = new Authen::PAM("webmin", "root", \&pam_conv_func))) {
+	if (! ref($pamh = new Authen::PAM("miniserv", "root", \&pam_conv_func))) {
 		print STDERR "PAM module available, but error during init !\n";
 		print STDERR "Disabling PAM functions.\n";
 		}
@@ -159,7 +159,7 @@ if ($use_ssl) {
 
 # Setup syslog support if possible and if requested
 if ($use_syslog) {
-	eval { openlog("webmin", "cons,pid,ndelay", "daemon") };
+	eval { openlog("miniserv", "cons,pid,ndelay", "daemon") };
 	$use_syslog = 0 if ($@);
 	}
 
@@ -268,7 +268,7 @@ die "Failed to bind port $config{port} : $!" if ($i == 5);
 listen(MAIN, SOMAXCONN);
 
 if ($config{'listen'}) {
-	# Open the socket that allows other webmin servers to find this one
+	# Open the socket that allows other miniserv servers to find this one
 	$proto = getprotobyname('udp');
 	if (socket(LISTEN, PF_INET, SOCK_DGRAM, $proto)) {
 		setsockopt(LISTEN, SOL_SOCKET, SO_REUSEADDR, pack("l", 1));
@@ -507,7 +507,7 @@ while(1) {
 		}
 
 	if ($config{'listen'} && vec($rmask, fileno(LISTEN), 1)) {
-		# Got UDP packet from another webmin server
+		# Got UDP packet from another miniserv server
 		local $rcvbuf;
 		local $from = recv(LISTEN, $rcvbuf, 1024, 0);
 		next if (!$from);
@@ -710,7 +710,7 @@ if (@deny && &ip_match($acptip, $localip, @deny) ||
 
 if ($use_libwrap) {
 	# Check address with TCP-wrappers
-	if (!hosts_ctl("webmin", STRING_UNKNOWN, $acptip, STRING_UNKNOWN)) {
+	if (!hosts_ctl("miniserv", STRING_UNKNOWN, $acptip, STRING_UNKNOWN)) {
 		&http_error(403, "Access denied for $acptip");
 		return 0;
 		}
@@ -739,8 +739,8 @@ if (%users) {
 	$blocked = 0;
 
 	# Session authentication is never used for connections by
-	# another webmin server
-	if ($header{'user-agent'} =~ /webmin/i) {
+	# another miniserv server
+	if ($header{'user-agent'} =~ /miniserv/i) {
 		$config{'session'} = 0;
 		}
 
@@ -1783,7 +1783,7 @@ return 0 if (!$_[0] || !$users{$_[0]});
 if ($users{$_[0]} eq 'x' && $use_pam) {
 	$pam_username = $_[0];
 	$pam_password = $_[1];
-	local $pamh = new Authen::PAM("webmin", $pam_username, \&pam_conv_func);
+	local $pamh = new Authen::PAM("miniserv", $pam_username, \&pam_conv_func);
 	if (!ref($pamh)) {
 		print STDERR "PAM init failed : $pamh\n";
 		return 0;
diff --git a/perl-install/standalone/interactive_http/miniserv.users b/perl-install/standalone/interactive_http/miniserv.users
new file mode 100644
index 000000000..f7338497a
--- /dev/null
+++ b/perl-install/standalone/interactive_http/miniserv.users
@@ -0,0 +1 @@
+root:x:0