#!/usr/bin/perl -w 

# Up2us -- RPM package manager manager for linux and beyond
# THIS MODULE: main executable; contains top-level and Gtk code.
# $Id: up2us,v 1.41 2003/04/08 20:35:24 tomj Exp $

# Copyright Tom Jennings 2002-2003
# tomj@wps.com, http://wps.com
# 
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public
# License along with this program; if not, write to the Free
# Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.

# ------------------------------------------------------------
# The following Simon Says trivia is to allow up2us/up2date to
# update up2us while it is running, by placing the modules in
# a version/release specific subdirectory. Further, we want to
# put all the version-defining junk in one place, namely this
# very module. 
#
# Make extracts version/release data below to make with, and passes
# it to the RPM build process.
#
# We also need to dynamically locate our modules. The normal 'use'
# pragma assumes that the (string) arguments are defined at compile
# time. With this scheme they are defined at run time, hence the use
# of 'require' instead of 'use module'. (The typical penalty of deferred
# error messages is moot here.) 'use lib' for some reason generates
# errors, so each module 'require' is explicit. Eh.
#
# It would have been obviously easier for the Make process to 
# extract the necessary version/release data from a simple fixed
# 'use lib "/usr/share/up2us/1.0-3"', but this is slightly cleaner.
# I think.
#
package main;
my %VERSION= (
	PKG => "up2us",
	VERSION => "1.1",
	RELEASE => "2",
	ARCH => "i386",
	PATH => "/usr/share",
);
# ------------------------------------------------------------
# All this trivia is so that our modules are located in a version-release
# named subdirectory, so that up2us can update itself without ruin.
#

my $modpath= "$VERSION{PATH}/$VERSION{PKG}/$VERSION{VERSION}-$VERSION{RELEASE}";
# $modpath= "."; print "\n\nWARNING: MODPATH\a\n";

require "$modpath/Header.pm";
require "$modpath/cmdline.pm";
require "$modpath/config.pm";
require "$modpath/dns.pm";
require "$modpath/execute.pm";
#
# ------------------------------------------------------------

use Exporter();
use Getopt::Long;		# command line junk,


# These are pack_* parameters.

# Packed widgets of fixed size.
@FIXED= (
	0,	# 0=shrink box to enclose widgets; 1=make widgets fill box
	0,	# 0=extra space is extra space; 1=expand widgets to fill box
	5,	# padding around widgets
);

# Pack widgets so that they expand to fill the enclosing box.
@FILL= (
	1,	# 0=shrink box to enclose widgets; 1=make widgets fill box
	1,	# 0=extra space is extra space; 1=expand widgets to fill box
	5,	# padding around widgets
);

# Main window definitions. 

my $MAIN_WINDOW_WIDTH= 500;
my $MAIN_WINDOW_HEIGHT= 0;
my $MAIN_BORDER_WIDTH= 0;

# One-line text entry/display box dimensions.

$ONE_LINE_HEIGHT= 18;

# Dimensions of buttons.

my $BUTTON_WIDTH= 60;                   # width of individual buttons,
my $BUTTON_HEIGHT= 30;                  # height of individual buttons
my $BUTTON_SPACING= 20;			# space 'tween
my $BUTTON_BORDER_WIDTH= 10;		# empty space around,
my $BUTTON_FRAME_WIDTH= 8;		# empty space around enclosing frame,

my $BUTTON_BOX_HEIGHT= 40;              # height of box that encloses buttons
my $BUTTONS_HEIGHT= 60;                 # height of entire &buttons widget

#  REPOSITORY window definitions.

my $REP_CLIST_HEIGHT= 100;		# initial list height
my $CHECKCOL= 0;			# the enable/disable repository column,
my $REPCOL= 1;				# the repository column
my $STATCOL= 2;				# up2us status
my $UP2COL= 3;				# last up2date status

my $CHECKCOL_WIDTH= 12;			# the check mark,
my $REPCOL_WIDTH= 90;			# repository name,
my $STATCOL_WIDTH= 60;			# "DONE", "DO AGAIN", etc
my $UP2COL_WIDTH= 200;			# last update status

# Generic dialog box dimensions, eg. ask() and ack(). Let's
# for now make it half of the main window width.

my $DIALOG_WIDTH= $MAIN_WINDOW_WIDTH / 2;
my $DIALOG_HEIGHT= 0;			# need to be adjustable

# Help window.

my $HELP_WIDTH= 400;
my $HELP_HEIGHT= 300;

$MAXLEN= 80;				# maximum length of any input field

$noerror= 0;
$generror= 1;				# generic "error"
$wcferror= 2;				# error writing config file(s)
$rcferror= 3;				# error reading config file(s)
$suderror= 4;				# error saving up2date config
$ruderror= 5;				# error restoring up2date config
$mfferror= 6;				# multiple errors involving files
$crcerror= 7;				# crash recovery failed

# These are used globally for button labels and return codes.
$OK= "OK";
$ERROR= "ERROR";
$YES= "YES";
$NO= "NO";

# Crash-recovery and config-loading dialogs.
# up2us
$savefail_title= "Startup failure";
$crash_title= "Crash recovery";
$readconfig_title= "Configuration read problem";
$exit_title= "Configuration exit problem";

$crash1= "It appears that Up2us crashed when it was last executed; "
	. "clicking $YES will restore Up2date's original configuration "
	. "file. Click $NO and Up2us will terminate with no changes.";

$crash2= "Up2date configuration recovered OK. You may Quit now or "
	. "continue with Up2us normally.";

$readconfigerr= "ERROR: %s Up2us can't continue, aborting.";

# Removal of previous versions.

$remove_title= "Recent upgrade";
$remove1= "Up2us was recently upgraded; should I delete "
	. "previous versions? (recommended)";


# ------------------------------------------------------------
# Our top-level window, and the CList used for the REPOSITORY window,
# are globally accessed. 
my $main_w;			# our main window
my $main_v;			# top-level VBox
my $main_t;			# top-level text box for messages
my $main_c;			# repository CList
my $main_c_row;			# recently-selected row,
my $main_c_col;			# recently-selected col,
my $main_u;			# "UPDATE" button
my $main_a;			# "ADD" button,
my $main_r;			# "REMOVE" button,
my $main_d;			# "DONE" button,


# Top-level HELP window.
my $help_w;
my $help_v;

# (These will disappear with restructuring as objects or
# passed local scope stuff.)

# Result for the ask() dialog.
my $ask_result;

# Vars for the add-repository dialog.
my $add_w;			# box
my $add_name;			# text: rep name
my $add_sslurl;			# text: SSL URL
my $add_nosslurl;		# text: no SSL URL
my $rhnreg;			# checkbutton: register


# ------------------------------------------------------------
# Things to do before we even look at Gtkish things.

	use vars qw/$opt_update $opt_add $opt_server $opt_del
	$opt_list $opt_noSSLServer $opt_verbose $opt_version
	$opt_help/;

	GetOptions (
	    "list" => 		\$opt_list,
	    "add=s" => 		\$opt_add,
	    "remove=s" =>	\$opt_remove,
	    "server=s" =>	\$opt_server,
	    "noSSLServer=s" =>	\$opt_noSSLServer,
	    "verbose" => 	\$opt_verbose,
	    "update" => 	\$opt_update,
	    "version" => 	\$opt_version,
	    "help" =>    	\$opt_help

	);

	if ($opt_help) {
		print << "ENDHELP";

up2us. Try:

--update                  Update from all enabled repositories, 
                          non-interactively.
--list                    List repositories.
--remove [NAME]           Remove repository [NAME].
--add [NAME]              Add repository [NAME] non-interactively. Requires 
                          one or both URLs.
--server [hostname]       Current repository hostname, with SSL service.
--noSSLserver [hostname]  Current repository hostname, without SSL.
--verbose                 Output a lot of chatter to stdout.
--version                 Print version info to stdout and exit.
--help                    This summary.
ENDHELP
		exit 0;
	}
	if ($opt_version) {
		print "Program $VERSION{PKG}, version $VERSION{VERSION}, ";
		print "release $VERSION{RELEASE}, arch $VERSION{ARCH}.\n";
		exit 0;
	}

# ------------------------------------------------------------

# Split off to the command line interfaces first. These don't return.

	&cmdline() if $opt_update;
	&cmdlinelist() if $opt_list;
	&cmdlinedel($opt_remove) if $opt_remove;
	&cmdlineadd($opt_add, $opt_server, $opt_noSSLServer)
	    if $opt_add;

# GUI follows.

	Gnome->init('up2us');
	Gtk-> init;

# GTK-> init_check to test, use GUI!

# Create the main window. Everything runs from this one window.

	$main_w= new Gtk::Window ("toplevel");		# create main window,
	$main_w-> set_policy (1, 1, 0);
	$main_w-> signal_connect ("destroy", \&handle_exit);
	$main_w-> set_usize ($MAIN_WINDOW_WIDTH, $MAIN_WINDOW_HEIGHT);
	$main_w-> set_title ("Up2us update agent");
	$main_w-> border_width ($MAIN_BORDER_WIDTH);

# We start of course with the "welcome" window. The vbox
# created here is just a dummy, since the first thing the top-level
# functions do is remove the previous window's widgets.

	$main_v= new Gtk::VBox (0, 0);			# dummy container
	$main_w-> add ($main_v);			# immediately removed.
	&handle_welcome;				# start with WELCOME,

# NOTE: Errors detected in here can't use &error(), as that
# assumes that the config files are sane and loaded properly.
#
# e e e e e e e e e e e e e e e e e e e e e e e e e e e e e

# First we need to read out main config file, from whence all 
# knowledge flows; die now elsewise.

	my $r= &read_up2us_config;			# read config files,
	if ($r ne $OK) {				# oops,
		&ack ($readconfig_title, sprintf ($readconfigerr, $r));
		Gtk-> exit ($rcferror);			# sigh, error out.
	}

# We now have valid config data. Try to detect a crash,
# where the up2date file is not original. Restore it
# if possible.

	Gtk-> exit ($crcerror) if &crash_recovery ne $OK;

# Check for previous-version cleanup.

	&removal_check;

# e e e e e e e e e e e e e e e e e e e e e e e e e e e e e

# Now that we know up2date's config is correct (or we are not executing
# here :-) make a copy for safe-keeping. Read_up2date_config() uses
# the copy, too.

	$r= &up2date_original_save;			# save up2date config
	if ($r ne $OK) {				# oops
		&ack ($savefail_title, $r);		# bad error,
		Gtk-> exit ($suderror);			# can't continue.
	}	

# Now load up2date's config files.

	$r= &read_up2date_config;			# read config files,
	if ($r ne $OK) {				# oops,
		&ack ($readconfig_title, sprintf ($readconfigerr, $r));
		Gtk-> exit ($rcferror);			# sigh, error out.
	}

# How tedious. OK to start now.

	Gtk-> main;
	exit (0);

# Perform crash recovery if required; return OK if success (or
# not needed).

sub crash_recovery {
my $r;

	return $OK if &up2date_original_check eq $OK;	# no problemo,

	if (&ask ($crash_title, $crash1)) {		# oops, "...recover?"
		$r= &up2date_original_recover ();
		if ($r eq $OK) {
			&ack ($crash_title, $crash2);	# "successful"
			return $OK;

		} else {				# could not recover!
			&ack ($crash_title, $r);
			return $r;
		}
	}
	return $ERROR;					# declined recovery.
}

			

# ------------------------------------------------------------
# WELCOME WINDOW.
#
# WELCOME, initial window, invoked at program startup or
# BACK button from the subsequent windows. This presents
# a canned welcome message and links to the main subfunctions.

sub handle_welcome {

	$main_w-> remove ($main_v);			# remove previous,
	$main_w-> add ($main_v= new Gtk::VBox (0, 0));	# new containing box
	$main_v-> pack_start (&fixed_text ("Welcome to up2us update agent."), 
	    @FILL);
	$main_v-> pack_end (
	    &buttons (
		"Help:handle_help:welcome",
		"Quit:handle_exit",
		"Setup:handle_setup",
		"Update:handle_update"),
	    @FIXED);
	$main_w-> show_all;
}








# ------------------------------------------------------------
# SETUP WINDOW.
#
# Manage repository data. 

sub handle_setup {
	$main_w-> remove ($main_v);			# remove previous,
	$main_w-> add ($main_v= new Gtk::VBox (0, 0));	# new containing box
	$main_v-> pack_start (
	    &fixed_text ("Create, remove, modify, or enable/disable repositories.\n"),
	    @FIXED);
#	$main_v-> pack_start (new Gtk::HSeparator, @FIXED);

# Make the big CList and add to the main window. It expands to fill
# the box (window).

	$main_v-> pack_start (&repository_clist, @FILL);
#	$main_c-> set_usize (0, 200);
	$main_c-> signal_connect ('select_row', \&handle_selected);

# Make the buttons, stick 'em in a box. Some buttons are local (back, etc)
# so we don't need to know the widget globally.

	($main_r)= &button_list ("Remove:handle_remove");
	$main_v-> pack_start (
	    &button_box (&button_list ("Help:handle_help:update", 
					"Back:handle_welcome",
					"Add:handle_add"),
					$main_r), 
	    @FIXED);
	&main_c_deselect_row;				# unselect all,
	&enable_remove_button;				# enable if any exist,
	&update_rep_clist;				# produce visible list,
	$main_w-> show_all;
}

# Install the list of repositories into the big CList. We basically
# wipe it out and reuild it every time; it's not likely to ever 
# be very big.

sub update_rep_clist {

	$main_c-> freeze;				# avoid jarring
	$main_c-> clear;				# empty the list,
	my @L= &rep_list;				# get list of rep's,
	foreach (@L) {					# add 'em all
		my $enable= &rep_item ("$_.disable") ? " " : "X";
		my ($stat, $date)= split (/ /, 
		    &rep_item ("$_.last-up2date"));
		$main_c-> append ($enable, $_, $stat, $date);
	}
	$main_c-> append (" ", None, " ", " ")
	    if scalar @L == 0;				# empty list,

	$main_c-> thaw;					# avoid jarring
}

# ADD dialog, prompts for the basics for a new repository.
# This leaves the parent window (SETUP) in place, to show
# context.

sub handle_add {

	$add_w= new Gtk::Window ("toplevel");		# create error window,
	$add_w-> set_title ("Up2us : Setup : Add new repository");
#	$add_w-> set_usize (300, 200);
#	$add_w-> set_position ('center');
	$add_w-> set_modal (1);				# command attention
	$add_w-> set_policy (0, 0, 0);
	$add_w-> signal_connect ("destroy", \&handle_adddone);
#	$add_w-> border_width (2);

	$add_w-> add (my $v= new Gtk::VBox (0, 0));		# a container,
	$v-> pack_start ($main_t= &text ("Add a new repository.\nA unique name and at least one server is required.\n"), 
	    0, 0, 0);					# say what's up,
	$v-> pack_start (new Gtk::HSeparator, 0, 0, 0);	# a nice bar,

# Into the vbox place a table with rows prompting for data;
# prompt text on the left and editable boxes on the right.

	my $t= new Gtk::Table (2, 2, 0);		# table to format
	$t-> set_row_spacing (0, 2);			# text and
	$t-> set_col_spacing (0, 2);			# scrollbar
	$t-> attach_defaults (new Gtk::Label ("Name:"),             0, 1, 0, 1);
	$t-> attach_defaults (new Gtk::Label ("Server (SSL):"),     0, 1, 1, 2);
	$t-> attach_defaults (new Gtk::Label ("Server (no SSL):"),  0, 1, 2, 3);
	$t-> attach_defaults (new Gtk::Label ("Fetch certificate:"),0, 1, 3, 4);
	$t-> attach_defaults (new Gtk::Label ("SSL certificate"),   0, 1, 4, 5);

	$t-> attach_defaults ($add_name= &edit_text,		    1, 2, 0, 1);
	$t-> attach_defaults ($add_sslurl= &edit_text,		    1, 2, 1, 2);
	$t-> attach_defaults ($add_nosslurl= &edit_text,	    1, 2, 2, 3);
	$t-> attach_defaults ($rhnreg= new Gtk::CheckButton (),	    1, 2, 3, 4);
	$rhnreg-> set_active (1);			# defaults ON,
	$v-> pack_start ($t, 0, 0, 0);

	$v-> pack_start (
	    &buttons ("Cancel:handle_addquit",		# quit, no save,
	        "Clear:handle_addclear",		# clear all,
	        "Add:handle_adddone"),			# check & save,
	    0, 0, 0);

	$add_w-> show_all;
}

# Handle clearing the fields.

sub handle_addclear {
my ($widget, $data)= @_;

	$add_name-> set_point (0); 
	$add_name-> forward_delete ($add_name-> get_length);
	$add_sslurl-> set_point (0); 
	$add_sslurl-> forward_delete ($add_sslurl-> get_length);
	$add_nosslurl-> set_point (0); 
	$add_nosslurl-> forward_delete ($add_nosslurl-> get_length);
}

# Handle quitting ADD.

sub handle_addquit {
my ($widget, $data)= @_;

	$add_w -> hide;
}




# Handle done adding repository; passed data tells us 
# how to handle things, either abandon or sanity-check 
# and save. This does all the hard work of adding a repository.

sub handle_adddone {
my ($widget, $data)= @_;

# Get text from the text widgets, enforcing max. string length.
# FIXME set real values instead of -1's!

	my $rep= uc join '', 
	    split ('', $add_name-> get_chars (0, -1), $MAXLEN);
	my $URL1= join '', 
	    split ('', $add_sslurl-> get_chars (0, -1), $MAXLEN);
	my $URL2= join '', 
	    split ('', $add_nosslurl-> get_chars (0, -1), $MAXLEN);

# Given these, check, munge and install new repository data. If
# add_new_repository() succeeds, we have repository data in the
# config file; if we need to failor back out this must be deleted.

	my $e= &add_new_repository ($rep, $URL1, $URL2);
	if ($e ne $OK) {
		&ack ("Add:ERROR", $e);
		return;
	}
	&update_rep_clist;				# update the list,

# Before we can register we need to fetch the SSL certificate
# from the server; we'll fetch the GPG keyring at the same time.

	&add_msg ("Fetching authentication and signature information from server.\n");
	$e= &get_auth_junk ($rep);
	if ($e ne $OK) {
	&add_msg ("Failed.\n");
		&ack ("Add:AUTH", $e);
		&del_repository ($rep);			# failed, remove it,
		&update_rep_clist;			# update the list,
		return;
	}
	&add_msg ("Success.\n");

# Now register with this server. Loop until either registration
# is successful, or the user quits.

	while (1) {
		&add_msg ("Registering at this repository. This may take a few minutes.\n");
		$status= &run_prog ("register", $rep);
		last if $status eq $OK;
		last if not &ask ("Add:Registration error",
		    "Unable to register at this repository; try again?");
	}

# Either successful or we gave up in frustration.

	if ($status eq $OK) {				# if completed OK,
		&add_msg ("Success.\n");
		$e= &save_rep_systemid ($rep);		# save created file,
		&add_msg ("Saving new systemID.\n");
		if ($e ne $OK) {			# oh crap, failed 
			&add_msg ("Failed.\n");
			&ack ("Add:Registration error", 
			    "$e; cannot continue.");
		} else {
			&add_msg ("Success.\n");
			&logorrhea ("Successfully registered at $rep.\n");
			&set_rep_item ("$rep.last-register", "OK " . &gtod);
			&ack ("Add:Success",
			    "Registration at repository $rep successful.");
		}

	} else {
		&add_msg ($status);
		&add_msg ("Unable to register at this repository.\n");
		&del_repository ($rep);			# failed, remove it,
		&update_rep_clist;			# update the list,
	}
	$add_w -> hide;
}

#############################################################
#
# $msg= &add_new_repository ("name", "SSL URL", "noSSL URL");
#
# Given the above items, error-check, build and store repository
# config. Returns $OK if no error else an error message.

sub add_new_repository {
my $rep= shift;
my $URL1= shift;
my $URL2= shift;

# Make sure the repository name exists and is unique.

	$rep= uc $rep;					# force upper case
	return "You must provide a name for this repository." if $rep eq "";

# FIXME: break out edit-existing.

	foreach (&rep_list) {
		return "There is already a repository named $rep."
		    if uc ($rep) eq uc ($_);
	}

# Check that at least one of the server fields is filled in,
# and that filled-in servers are syntactically correct.

	return "You must enter at least one server."
	    if not ($URL1 or $URL2);
	$URL2= $URL1 if not $URL2;			# make the blank one
	$URL1= $URL2 if not $URL1;			# the other.

	my $error= "";					# total error(s),
	my $e= "";					# local error,

	$error= "Server $URL1: $e. "			# build error message,
	     if $e= &checkfqdn ($URL1, "0S"); 		# if FQDN error,
	$error .= "Server $URL2: $e. "
	    if $e= &checkfqdn ($URL2, "0S");
	return $error if $error;

# Server(s) are syntactically correct; see if they exist. If not, issue
# FIXME a warning before continuing.

	$error= "Server $URL1: $e."
	    if $e= &checkfqdn ($URL1, "0E");		# check it resolves,
	$error .= "Server $URL2: $e."
	    if $e= &checkfqdn ($URL2, "0E");
	return $error if $error;

# Build the complete URL from the server name(s) entered.

	$URL1= "https://$URL1/XMLRPC" if $URL1;		# SSL 
	$URL2= "http://$URL2/XMLRPC" if $URL2;		# no SSL

# Now store the data we just built into the repository
# config file. 

	&rep_add ($rep);				# add to the list,
	&set_rep_item ("$rep.serverURL", $URL1);
	&set_rep_item ("$rep.noSSLServerURL", $URL2);
	&set_rep_item ("$rep.last-up2date", "ADDED " . &gtod);
	&set_rep_item ("$rep.last-register", "NEVER " . &gtod);

# Note that the data that these items points to DOESN'T YET
# EXIST. They will be fetched/created in subsequent steps.
# The routines that do that need to know where the data goes.

	&set_rep_item ("$rep.systemIdPath", &upd_item ("systemIdPath") . ".$rep");
	&set_rep_item ("$rep.sslCACert", &upd_item ("sslCACert") . ".$rep");
	&set_rep_item ("$rep.gpgKeyRing", &upd_item ("gpgKeyRing") . ".$rep");

	return $OK;
}



#############################################################
#
# &repository_clist;
#
# Create a scrolling CList widget that contains all of the
# repositories and status. This uses the global vars to
# store things.

sub repository_clist {

	my $s= new Gtk::ScrolledWindow(undef, undef);
	$s-> set_usize (0, $REP_CLIST_HEIGHT);
	$s-> set_policy ('automatic', 'automatic');

	$main_c= new_with_titles Gtk::CList 
	    ("", "Repository", "Status", "Status date");
	$main_c-> set_shadow_type ('etched_out');	# make pretty,
	$main_c-> column_titles_passive;		# default inactive,

	# CHECK column.
	$main_c-> set_column_justification ($CHECKCOL, 'center'); 
	$main_c-> set_column_width ($CHECKCOL, $CHECKCOL_WIDTH);
	$main_c-> column_title_active ($CHECKCOL);	# un/check ALL

	# REPOSITORY column.
	$main_c-> set_column_justification ($REPCOL, 'left'); 
	$main_c-> set_column_width ($REPCOL, $REPCOL_WIDTH);

	# STATUS column.
	$main_c-> set_column_justification ($STATCOL, 'left'); 
	$main_c-> set_column_width ($STATCOL, $STATCOL_WIDTH);

	# UP2DATE column.
	$main_c-> set_column_justification ($UP2COL, 'left'); 
	$main_c-> set_column_width ($UP2COL, $UP2COL_WIDTH);

	$s-> add_with_viewport ($main_c);		# add to main vbox,
	return $s;					# ScrolledWindow
}






# ------------------------------------------------------------
# UPDATE WINDOW.
# Invokes up2date per repository, as indicated.

sub handle_update {

	$main_w-> remove ($main_v);			# remove previous,
	$main_w-> add ($main_v= new Gtk::VBox (0, 0));	# new containing box

# We don't use fixed_text() to put up the text; we'll later
# scroll log data through it so use text and text_box.

	$main_t= &text ("Run \"up2date\" for each repository enabled with a checkmark by clicking UPDATE\n");
	$main_v-> pack_start (&text_box ($main_t), @FIXED);
#	$main_v-> pack_start (new Gtk::HSeparator, 0, 0, 0);

# Make the big CList and add to the main window. It expands to fill
# the box (window).

	$main_v-> pack_start (&repository_clist, @FILL);
	&update_rep_clist;				# nice to look at
	$main_c-> signal_connect ('select_row', \&handle_selected);

	($main_u)= &button_list ("Update:handle_doupdate");
	($main_d)= &button_list ("Done:handle_exit");
	$main_v-> pack_start (
	    &button_box (&button_list ("Help:handle_help:update", 
					"Back:handle_welcome"),
					$main_u,
					$main_d), 
	    0, 0, 0);
	&enable_update_button;				# if any enabled,
	&enable_done_button;				# if all are DONE (not),
	$main_w-> show_all;
}





# END window handlers.
#
# ------------------------------------------------------------



# Big fat error, display a message, wait for click then exit.

sub error {
my $uselesswidget= shift;
my $e= shift;

	$e= "ERROR" if not defined $e;			# mainly for testing.

	my $w= new Gtk::Window ("toplevel");		# create error window,
	$w-> set_title ("Up2us FATAL ERROR");
#	$w-> set_usize (250, 250);
	$w-> set_position ('center');
	$w-> set_modal (1);				# command attention
	$w-> set_policy (0, 0, 0);
	$w-> signal_connect ("destroy", \&handle_errorexit);
#	$w-> border_width (2);

	$w-> add (my $v= new Gtk::VBox (0, 0));		# a container,
	$v-> pack_start (&fixed_text ($e), 0, 0, 0);	# add the text,
	$v-> pack_start (&buttons ("Bummer:handle_errorexit"), 0, 0, 0);

	$w-> show_all;
}

# Put up a dialog box with an ACKNOWLEGED button and a fixed message.
# Always return OK.

sub ack {
my ($title, $msg)= @_;

	my $w= new Gtk::Window ("toplevel");		# create error window,
	$w-> set_title ("Up2us: $title");
	$w-> set_usize ($DIALOG_WIDTH, $DIALOG_HEIGHT);
	$w-> set_position ('center');
	$w-> set_modal (1);				# command attention
	$w-> set_policy (0, 0, 0);
	$w-> signal_connect ("destroy", \&handle_ask_no);
#	$w-> border_width (2);

	$w-> add (my $v= new Gtk::VBox (0, 0));		# a container,
	$v-> pack_start (my $t= &fixed_text ($msg), 0, 0, 0); # add the text,
	$v-> pack_start (
	    &buttons ("OK:handle_ask_no"),	# only one response
	    0, 0, 0);

	$w-> show_all;
	for ($ask_result= undef; not defined $ask_result;) {
		&while_idle();			# run things from here
	}
	$w-> hide;					# get rid of the box,
}


# Put up a dialog box with YES and NO buttons and a fixed message.
# Returns true if YES is clicked.

sub ask {
my ($title, $msg)= @_;

	my $w= new Gtk::Window ("toplevel");		# create error window,
	$w-> set_title ("Up2us: $title");
	$w-> set_usize ($DIALOG_WIDTH, $DIALOG_HEIGHT);
	$w-> set_position ('center');
	$w-> set_modal (1);				# command attention
	$w-> set_policy (0, 0, 0);
	$w-> signal_connect ("destroy", \&handle_ask_no);
#	$w-> border_width (2);

	$w-> add (my $v= new Gtk::VBox (0, 0));		# a container,
	$v-> pack_start (&fixed_text ($msg), 0, 0, 0);	# add the text,
	$v-> pack_start (
	    &buttons ("Yes:handle_ask_yes",		# add YES and NO,
	        "No:handle_ask_no"),
	    0, 0, 0);

	$w-> show_all;
	for ($ask_result= undef; not defined $ask_result;) {
		&while_idle();				# run things from here
	}
	$w-> hide;					# get rid of the box,
	return $ask_result;
}

# Handlers for ask() buttons.
sub handle_ask_yes { $ask_result= 1; return 0; }
sub handle_ask_no { $ask_result= 0; return 0; }



# Handler for error exit. Essentially the same as handle_exit,
# but with a different return code. If we get an error exiting,
# punt, and return unique error.

sub handle_errorexit {

	my $e= &exit_wrapup;
	Gtk-> exit ($e == $noerror ? $generror : $mfferror);
}

# Normal, no error exit, unless we encounter errors exiting. Get it?

sub handle_exit {

	Gtk-> exit (&exit_wrapup);
}

# Common code for the exit handlers; flush out dirty files
# and restore things to a pristine state, complaining carefully
# on error. We make every attempt to back out gracefully.
# The build_config_for creates a RedHat-functional (though not pristine)
# config file should recovery fail. None if this is likely, but
# it's a pain in the ass to lose config data, and code is cheap.

sub exit_wrapup {

	my $e= $noerror;				# assume no error,

	my $r= &build_config_for (&RedHat());		# make backup config,
	if ($r ne $OK) {
		&ack ($exit_title, $r);			# some error writing,
		$e= $wcferror;				# flag the error,
	}
	$r= &write_config_data;				# flush changes to disk,
	if ($r ne $OK) {
		&ack ($exit_title, $r);			# ack the error,
		$e= ($e ? $mfferror : $wcferror);	# remember it,
	}
	$r= &up2date_original_restore ();		# restore up2date conf,
	if ($r ne $OK) {				# sheesh, deep guano,
		&ack ($exit_title, $r);			# time to die.
		$e= ($e ? $mfferror : $ruderror);	# errors galore,
	}
	return $e;
}

# Handler for help. We're passed a text label to indicate the
# type of help; we load the entire help file into a window
# and position it so the indicated label is at the top. If that
# fails we leave it at the start of the file. Simple. The
# window is not modal.

sub handle_help {
my $e= shift;

	if (defined $help_w) {
		&handle_helpclose;

	} else {
		$help_w= new Gtk::Window ("toplevel");	# create error window,
		$help_w-> set_title ("Up2us help");
		$help_w-> set_usize ($HELP_WIDTH, $HELP_HEIGHT);
		$help_w-> set_policy (0, 0, 0);
		$help_w-> signal_connect ("destroy", \&handle_close_help);
		$help_w-> signal_connect ("delete_event", \&handle_close_help);
		$help_w-> border_width (2);

		$help_w-> add (my $help_v= new Gtk::VBox (0, 0)); # a container,
		$help_v-> pack_start (&fixed_text ("Here will appear a summary of what can be done at the current window."), 0, 0, 0); # add the text,
		$help_v-> pack_start (&buttons ("Close:handle_helpclose"), 
		    0, 0, 0);

		$help_w-> show_all;
	}
}

# Close the help window. The main window widget is set to undef
# to allow it's later re-creation.

sub handle_helpclose {

	$help_w-> hide;
}



# Handler to begin the up2date process for the list of
# enabled repositories.

sub handle_doupdate {

my $row;	# CList row we're working on,
my $rep;	# repository we're working on,
my $status;	# status of current repository

# Loop over each repository in the CList. There seems to be no way
# to retrieve a count of the rows in the CList, so we use the count
# of repositories since that's what it was built with. It seems less
# silly than counting the children in the CList.

	my @R= &rep_list;				# enabled repositories,
	my $rcount= @R;

# We skip repositories that are not enabled, or that are marked "Done"
# from a previous pass. We process each repository in turn unless
# &run_prog() detects an error.

	&update_button_disable;				# UPDATE button off
	$status= $OK;					# status if none done,

	for ($row= 0; $row < $rcount; $row++) {
		$rep= $main_c-> get_text ($row, $REPCOL);# get rep name
		next if &skip_this_repository ($row, $rep); # check enabled,

# Update this repository, check error return from up2date. This is
# somewhat problematic, as up2date's error returns are not fully known.

		&update_cell ($row, $STATCOL, "Working...");
		&add_msg ("Invoking up2date for repository $rep; ");
		&add_msg ("complete it then return here.\n");
		$status= &run_prog ("up2date", $rep);	# do actual work,
		if ($status eq $OK) {			# whew
			&add_msg ("Up2date for repository $rep successful.\n");
			&update_cell ($row, $STATCOL, "Done");
			&set_rep_item ("$rep.last-up2date", "OK " . &gtod);

		} else {
			&update_cell ($row, $STATCOL, "ERROR");
			&set_rep_item ("$rep.last-up2date", "ERROR " . &gtod);
			&add_msg ("ERROR: $status\n");
			last;
		}
		&while_idle();				# fixup sleep
		sleep 2;				# it just feels right
	}
	if ($status eq $OK) {
		&add_msg ("All updates completed.\n") if $row >= $rcount;
		&add_msg ("All are marked \"Done\"; click to clear it.\n\n") 
		    if $row == 0;
	}

# Make buttons sensitive or not, depending on data requirements.

	&enable_update_button;
	&enable_remove_button;
	&enable_done_button;
}

# Return true if we should skip this repository, eg. it's not enabled
# or we've done it already.

sub skip_this_repository {
my ($row, $rep)= @_;

	if ($main_c-> get_text ($row, $STATCOL) eq "Done") {
		&add_msg ("Repository $rep is up to date.\n");
		return 1;
	}
	if (&rep_item ("$rep.disable", 0) == 1) { # if disabled,
		&add_msg ("Repository $rep was skipped (disabled).\n");
		&update_cell ($row, $STATCOL, "Skipped");
		return 1;
	}
	return 0;
}


# Handler for remove repository. Remind the human that a simple
# disable might do the trick better than losing data.

sub handle_remove {
my ($widget, @data)= @_;

	return 1 if not defined $main_c_row;		# oops

	my $rep= $main_c-> get_text ($main_c_row, 1);	# get repository name,
	if (&RedHat ($rep)) {				# hmm, magical,
		&ack ("remove repository", 
		    "The &RedHat() repository cannot be removed.");

	} elsif (&ask ("up2us remove repository", 
	    "Clicking \"YES\" will permanently remove all data for repository $rep; if you only want to skip updating from this repository you can click \"X\" to disable it.")) {

		&del_repository ($rep);			# delete the sucker
		&update_rep_clist;			# build new list,
#		$main_c-> remove ($main_c_row);		# delete the row,
#		$main_c_row= undef;			# require select
	}
	&enable_remove_button;				# will disable it.
	return 1;
}


# Handler for repository select row. If the enable/disable column
# is clicked, toggle the disable state (as it's known in the config
# file). Other select events are ignored. 
#
# We also check if any repositories are enabled; if none, we
# disable the "update" button.

sub handle_selected {
my ($widget, $row, $column, $event, @data)= @_;

	$main_c_row= $row;
	$main_c_col= $column;				# remember selection,

	$widget-> freeze;				# avoid vertigo,
	if ($column == $CHECKCOL) {			# enable/disable,
		my $rep= $widget-> get_text ($row, 1);	# get repository name,
		&set_rep_item ("$rep.disable", 		# toggle disable
		    &rep_item ("$rep.disable", 0) != 0 ? 0 : 1);

		&update_cell ($row, $CHECKCOL, 		# update the CList,
		    &rep_item ("$rep.disable") ?  "" : "X");
		&enable_update_button;			# enable/disable UPDATE,
		$widget-> set_text ($row, $STATCOL, "--");

	} elsif ($column == $STATCOL) {			# clear "DONE" status,
		$widget-> set_text ($row, $STATCOL, "Do again")
		    if ($widget-> get_text ($row, $STATCOL) eq "Done");
	}
	$widget-> thaw;					# whew.
	&enable_remove_button;
	return 1;
}

# Clear the text box.

sub clear_msg {

	&add_text ($main_t, 1, "");			# clear, then add nothing
}


# Write a message to the text box.

sub add_msg {
my $msg= shift;

	&add_text ($main_t, 0, $msg);			# add text.
}

# Set the status cell of a repository CList row to 
# some message. The order of select_row, moveto, and freeze/thaw
# seems really critical, why?

sub update_cell {
my ($row, $col, $msg)= @_;

	$main_c-> select_row ($row, $REPCOL);		# select the row,
	$main_c-> moveto ($row, 0, 0.5, 0.0);		# center the list row,
	$main_c-> freeze;
	$main_c-> set_text ($row, $col, $msg);		# new text,
	$main_c-> thaw;
	&while_idle();					# allow update now.
}


# Unselect all rows in the big CList.

sub main_c_deselect_row {

	$main_c_row= $main_c_col= undef;
}


#############################################################
#
# &enable_update_button ($forced_off);
#
# Enable or disable the "UPDATE" button depending on whether there
# are any repositories (1) defined and (2) enabled. 'forced_off'
# will disable it regardless.

sub enable_update_button {
my $force= shift;

	return if not defined $main_u;

	$e= 0;						# assume none,
	foreach (&rep_list) {
		next if &RedHat ($_);			# ignore magical rep,
		$e= 1 if &rep_item ("$_.disable", 0) == 0;
	}
	$e= $force if defined $force;			# maybe force it,
	$main_u-> set_sensitive ($e);			# enable/disable button
}


#############################################################
#
# &enable_remove_button;
#
# Enable or disable the "REMOVE" button depending on whether there
# and repositories to remove. We don't count &RedHat(), since it's
# magical.

sub enable_remove_button {

	return if not defined $main_r;

	$e= 0;						# assume none,
	foreach (&rep_list) {
		next if &RedHat ($_);			# ignore magical rep,
		$e= 1;
	}
	$e= 0 if not defined $main_c_row;		# no selection made!
	$main_r-> set_sensitive ($e);			# enable/disable button
}


#############################################################
#
# &enable_done_button;
#
# Enable the "DONE" button only if all repositories are
# marked DONE or SKIPPED.

sub enable_done_button {

	return if not defined $main_d;

	my $rcount= scalar (&rep_list);			# total repositories,
	my %X= ("Done"=> 1, "Skipped"=> 1);		# acceptable answers

	my $e= 1;					# assume none
	for (my $row= 0; $row < $rcount; $row++) {
		$e= 0 if not exists $X {$main_c-> get_text ($row, $STATCOL)};
	}
	$main_d-> set_sensitive ($e);			# enable/disable button
}

# &update_button_disable;
# &add_button_disable;
# &remove_button_disable;
#
# Forces buttons off (insensitive).

sub update_button_disable { $main_u-> set_sensitive (0); }
sub remove_button_disable { $main_r-> set_sensitive (0); }
sub add_button_disable { $main_a-> set_sensitive (0); }


#############################################################
#
# $widget= fixed_text ("message");
#
# Build a box with text floating in the center of it.

sub fixed_text {
my $msg= shift;

	my $x= new Gtk::Text (undef, undef);		# new Text widget,
	$x-> set_word_wrap (1);				# make text wrap,
	$x-> set_editable (0);				# canned message,
	$x-> set_sensitive (0);				# canned message,
	$x-> set_usize (0, 60);
	&add_text ($x, 1, $msg);			# stick text there.

	my $v= new Gtk::VBox (0, 0);			# box for the text,
	$v-> set_border_width (0);			# the border,
	$v-> pack_start ($x, @FILL);

	return $v;

}


#############################################################
#
# $widget= edit_text;
#
# Build a one-line editable text widget.

sub edit_text {

	my $x= new Gtk::Text (undef, undef);		# new Text widget,
	$x-> set_word_wrap (1);				# make text wrap,
	$x-> set_editable (1);
	$x-> set_sensitive (1);
	$x-> set_usize (80, $ONE_LINE_HEIGHT);
	return $x;

	my $v= new Gtk::VBox (0, 0);			# box for the text,
	$v-> set_border_width (0);			# the border,
	$v-> pack_start ($x, @FIXED);

	return $v;

}


#############################################################
#
# $widget= text_box ($text_widget);
#
# Build a box to contain the passed text widget.

sub text_box {
my $tw= shift;		# Text widget


	my $t= new Gtk::Table (2, 2, 0);		# table to format
	$t-> set_row_spacing (0, 2);			# text and
	$t-> set_col_spacing (0, 2);			# scrollbar
	$t-> attach ($tw, 0, 1, 0, 1,			# Text into table,
	    [ 'expand', 'shrink', 'fill' ],
	    [ 'expand', 'shrink', 'fill' ],
	    0, 0 );

	my $s= new Gtk::VScrollbar ($tw-> vadj);	# make scrollbar,
	$t-> attach ($s, 1, 2, 0, 1, 'fill',		# stick in table,
	    [ 'expand', 'shrink', 'fill' ], 0, 0 );

	my $v= new Gtk::VBox (0, 0);			# for text, scrollbar,
	$v-> pack_start ($t, @FIXED);			# box it up.

	return $v;
}

#############################################################
#
# $widget= &text ("text");
#
# Build a new text widget. It will get put into a text_box.
#
sub text {
my $msg= shift;

	my $x= new Gtk::Text (undef, undef);		# new Text widget,
	$x-> set_word_wrap (1);				# make text wrap,
	$x-> set_editable (0);				# canned message,
	$x-> set_sensitive (0);				# canned message,
	&add_text ($x, 1, $msg);
	return $x;
}

#############################################################
#
# &add_text ($widget, $clear, $msg);
#
# Add text to a text widget, optionally clearing it first.

sub add_text {
my ($widget, $flag, $msg)= @_;

	if ($flag) {
		$widget-> set_point (0);		# from top,
		$widget-> forward_delete ($widget-> get_length); # delete all
	}
	$widget-> insert (undef, $widget-> style-> black, undef, $msg);
}

#############################################################
#
# $widget= &buttons ("name:handler:data", "name:handler", ...);
#
# Build a box of buttons to go at the bottom of each window.
# Returns the enclosing container.

sub buttons {

	return &button_box (&button_list (@_));
}

#############################################################
#
# Create the specified buttons and return the list of widgets.
# The handler and optional data are passed as text.
#
# $widget= &button ("name:handler:data,data,data", "name:handler", ...);
#
sub button_list {
my @B;		# list of widgets we return

	foreach (@_) {
		my ($name, $handler, $arrayref)= split ':';
		my $b= new Gtk::Button ($name);
		$b-> set_usize ($BUTTON_WIDTH, $BUTTON_HEIGHT);
		$b-> signal_connect ('clicked', $handler, $arrayref);
		push @B, $b;
	}
	return @B;
}


#############################################################
#
# Create a horizontal box packed with the given buttons.
#
# $widget= &button_box (button, ...);
#
sub button_box {

# This VBox holds the horizontal separator and hbox containing
# the buttons, and determined vertical size.

	my $box= new Gtk::HButtonBox();			# new horiz box,
	$box-> set_spacing ($BUTTON_SPACING);
	$box-> set_layout ('end');			# pack towards right,
   	$box-> set_child_size ($BUTTON_WIDTH, $BUTTON_HEIGHT);

	while (@_) {
		my $b= shift;
		$box-> add ($b);
	}

	my $h= new Gtk::HBox (0, 0);			# box to contain buttons
	$h-> set_spacing ($BUTTON_SPACING);
	$h-> border_width ($BUTTON_BORDER_WIDTH);
	$h-> pack_end ($box, 0, 0, 0);			# add buttons,

	my $f= new Gtk::Frame( "up2us" );		# create a frame,
	$f-> border_width ($BUTTON_FRAME_WIDTH);	# with a border,
	$f-> add ($h);					# add the hbox,

	return $f;
}


#############################################################
#
# &while_idle();
#
# Essentially an interface "callback" from lower-level routines
# that may take a while to return, this allows Gtk to update windows
# and execute handlers. For a command-line interface this will
# likely be empty.

sub while_idle {

	Gtk-> main_iteration_do (0);
}



# ------------------------------------------------------------

#############################################################
#
# $date= &gtod;
#
# Returns the date & time, thusly:
#
# "2003-Jan-07.23:59:01"

sub gtod {

	my @L= localtime (time);
	return sprintf ("%d-%s-%02d.%02d:%02d:%02d",
	    $L[5] + 1900,
	    ("Jan", "Feb", "Mar", "Apr", "May", "Jun", 
	      "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")[$L[4]],
	    $L[3],
	    $L[2], $L[1], $L[0]);
}


#############################################################
#
# &removal_check;
#
# Checks if previous versions of up2us exist, and the configured
# state of previous-version handling, and returns:

sub removal_check {


# Check we have what we need first. If the config item isn't
# there generate default.

	my $ans= &cfg_item ('delete-old-up2us');	# get answer,
	&set_cfg_item ('delete-old-up2us', $ans= "Ask") if not defined $ask;
	if ($ans !~ /Yes|No|Ask/) {
		&logorrhea ("ERROR: Config item 'delete-old-up2us' can only be Yes/No/Ask!\n");
		return;
	}
	return if $ans eq "No";				# don't bother.

# Read the list of files that exist in the package directory.

	my $dir= "$VERSION{PATH}/$VERSION{PKG}";	# oh, it's useful, 

	opendir (DIR, $dir) or die ("Can't open directory \"$dir\" for cleanup!");
	my @F= readdir DIR;				# get list of files,
	closedir DIR;					# close it.

# Build a new list that contains the names of files/dirs to delete.

	my @RM;						# build list to delete,
	foreach (@F) {					# check what we found:
		next if /^\./;				# umm, we need these,
		next if $_ eq "README";			# keep this,
		next if $_ eq "$VERSION{VERSION}-$VERSION{RELEASE}"; # current
		push @RM, "$dir/$_";			# pathname to delete.
	}

# Decide whether to delete these or not.

	return if scalar @RM == 0;			# nothing to do,
	return if $ans eq "Ask" && 			# else ask,
	    ! &ask ($remove_title, $remove1);		# said no,

# Remove the list of files.

	map { print "Deleting $_\n"; } @RM;		# nice log,
	qx#rm -rf @RM#;					# remove it all,
}


#############################################################
#
# &logorrhea (string)
#
# Verbosity/error output. The passed string is output if
# --verbose is set, or if the string begins with "ERROR".

sub logorrhea {
my $s= join '', @_;

	print $s if $opt_verbose or $s =~ /^ERROR/;
}