<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl -w
# This file was preprocessed, do not edit!


package Debconf::FrontEnd::Web;
use IO::Socket;
use IO::Select;
use CGI;
use strict;
use Debconf::Gettext;
use base qw(Debconf::FrontEnd);



sub init {
	my $this=shift;

	$this-&gt;SUPER::init(@_);
	
	$this-&gt;port(8001) unless defined $this-&gt;port;
	$this-&gt;formid(0);
	$this-&gt;interactive(1);
	$this-&gt;capb('backup');
	$this-&gt;need_tty(0);

	$this-&gt;server(IO::Socket::INET-&gt;new(
		LocalPort =&gt; $this-&gt;port,
		Proto =&gt; 'tcp',
		Listen =&gt; 1,
		Reuse =&gt; 1,
		LocalAddr =&gt; '127.0.0.1',
	)) || die "Can't bind to ".$this-&gt;port.": $!";

	print STDERR sprintf(gettext("Note: Debconf is running in web mode. Go to http://localhost:%i/"),$this-&gt;port)."\n";
}


sub client {
	my $this=shift;
	
	$this-&gt;{client}=shift if @_;
	return $this-&gt;{client} if $this-&gt;{client};

	my $select=IO::Select-&gt;new($this-&gt;server);
	1 while ! $select-&gt;can_read(1);
	my $client=$this-&gt;server-&gt;accept;
	my $commands='';
	while (&lt;$client&gt;) {
		last if $_ eq "\r\n";
		$commands.=$_;
	}
	$this-&gt;commands($commands);
	$this-&gt;{client}=$client;
}


sub closeclient {
	my $this=shift;
	
	close $this-&gt;client;
	$this-&gt;client('');
}


sub showclient {
	my $this=shift;
	my $page=shift;

	my $client=$this-&gt;client;
	print $client $page;
}


sub go {
	my $this=shift;

	$this-&gt;backup('');

	my $httpheader="HTTP/1.0 200 Ok\nContent-type: text/html\n\n";
	my $form='';
	my $id=0;
	my %idtoelt;
	foreach my $elt (@{$this-&gt;elements}) {
		$idtoelt{$id}=$elt;
		$elt-&gt;id($id++);
		my $html=$elt-&gt;show;
		if ($html ne '') {
			$form.=$html."&lt;hr&gt;\n";
		}
	}
	return 1 if $form eq '';

	my $formid=$this-&gt;formid(1 + $this-&gt;formid);

	$form="&lt;html&gt;\n&lt;title&gt;".$this-&gt;title."&lt;/title&gt;\n&lt;body&gt;\n".
	       "&lt;form&gt;&lt;input type=hidden name=formid value=$formid&gt;\n".
	       $form."&lt;p&gt;\n";

	if ($this-&gt;capb_backup) {
		$form.="&lt;input type=submit value=".gettext("Back")." name=back&gt;\n";
	}
	$form.="&lt;input type=submit value=".gettext("Next")."&gt;\n";
	$form.="&lt;/form&gt;\n&lt;/body&gt;\n&lt;/html&gt;\n";

	my $query;
	do {
		$this-&gt;showclient($httpheader . $form);
	
		$this-&gt;closeclient;
		$this-&gt;client;
		
		my @get=grep { /^GET / } split(/\r\n/, $this-&gt;commands);
		my $get=shift @get;
		my ($qs)=$get=~m/^GET\s+.*?\?(.*?)(?:\s+.*)?$/;
	
		$query=CGI-&gt;new($qs);
	} until (defined $query-&gt;param('formid') &amp;&amp;
		 $query-&gt;param('formid') eq $formid);

	if ($this-&gt;capb_backup &amp;&amp; defined $query-&gt;param('back')  &amp;&amp;
	    $query-&gt;param('back') ne '') {
		return '';
	}

	foreach my $id ($query-&gt;param) {
		next unless $idtoelt{$id};
		
		$idtoelt{$id}-&gt;value($query-&gt;param($id));
		delete $idtoelt{$id};
	}
	foreach my $elt (values %idtoelt) {
		$elt-&gt;value('');
	}
	
	return 1;
}


1
</pre></body></html>