;;;; Hey Emacs, this script might as well be -*- lisp -*-
;;;;
;;;; Install_AmiTCP-2.0 - AmiTCP/IP 2.0 installation script for Installer
;;;;
;;;; Copyright © 1993 AmiTCP/IP Group, <amitcp-group@hut.fi>
;;;;
;;;; $Id: Install_AmiTCP-2.0,v 1.7 1993/08/15 07:33:07 ppessi Exp $
;;;;
;;;; This script has been tested with Installer 1.24:
;;;;
;;;;     Installer and Installer project icon
;;;;     (c) Copyright 1991-93 Commodore-Amiga, Inc.  All Rights Reserved.
;;;;     Reproduced and distributed under license from Commodore.
;;;;
;;;;     INSTALLER SOFTWARE IS PROVIDED "AS-IS" AND SUBJECT TO CHANGE;
;;;;     NO WARRANTIES ARE MADE.  ALL USE IS AT YOUR OWN RISK.  NO LIABILITY
;;;;     OR RESPONSIBILITY IS ASSUMED.
;;;;
;;;; Use following Icon tooltypes / Command line options:
;;;; APPNAME=AmiTCP/IP
;;;; MINUSER=AVERAGE
;;;;
(welcome "    Welcome to " @app-name " installation.\n"
	 "    We hope that after this installation your world of "
	 "communication will be much more broader than before.")
;;;;
;;;; "Needs"
;;;;
(set need-version 37) ; version of operating system need by AmiTCP/IP
(set need-memory (* 512 1024))
;;;
;;; Destination directories of the AmiTCP/IP
;;;
(set atcp-name "AmiTCP"
     atcp-assign (cat atcp-name ":")	; Assign to AmiTCP
     conf-dir (tackon atcp-assign "db")	; Configuration for AmiTCP
     bin-dir (tackon atcp-assign "bin")	; Binaries for AmiTCP
     doc-dir (tackon atcp-assign "doc")	; documentation for AmiTCP
     util-dir (tackon atcp-assign "util") ; directory for utilities source
     devs-dir (tackon atcp-assign "devs") ; devices directory
     networks-dir (tackon devs-dir "networks")
     src-dir (tackon atcp-assign "src")	; source for AmiTCP
					; includes for net applications
     include-dir (tackon atcp-assign "netinclude")
					; network link libraries
     lib-dir (tackon atcp-assign "netlib"))
;;;
;;; If you add directories above, then also add the name of the variable below.
;;; This is to have "for i in a b c d ..." construct
;;;
;;; needeed directories
(set dir-pat (cat
	      "(" "db"
	      "|" "bin"
	      "|" "doc"
	      ")"))

(set dir-pat-opt (cat
		  "(" "src"
		  "|" "netinclude"
		  "|" "netlib"
		  "|" "util"
		  "|" "devs"
		  ")")) ; these shoul be set bellow

;; The source directory name
(set source-dir (if (= 1 (exists @icon))
		    (pathonly (expandpath @icon))
		  (expandpath @icon)))

;; How to get needed information?
(set net-setup-help
     "    You can get this information from your network administration.\n")

;; copy "more" to ram: to be able to use it
(copyfiles
 (prompt "Copying sys:utilities/more to ram: for use")
 (source "SYS:Utilities/More")
 (dest   "RAM:")
 (safe)
 (optional "nofail"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-ip-address
 ;;  Procedure to ask an IP address
 ;;
 ;; arguments:
 ;;  ::ask-ip-prompt   - Prompt text
 ;;  ::ask-ip-help     - help text
 ;;  ::ask-ip-need     - empty result allowed if not true
 ;;
 ;; locally used names:
 ;;  ::ask-ip-result
 (set ::ask-ip-result "<none>")
 (while
     ((set ::ask-ip-result
	   (askstring
	    (prompt ::ask-ip-prompt
		    (if (NOT ::ask-ip-need)
			(cat "\nGive an empty string if you want to "
			     "by-pass this option."))
		    (if (NOT (= ::ask-ip-result "<none>"))
			(cat "\n\nYou entered an invalid value\n\""
			     ::ask-ip-result "\".\n"
			     "Enter a valid IP address.")))
	    (default (if (<> ::ask-ip-result "<none>") ::ask-ip-result ""))
	    (help net-setup-help
		  ::ask-ip-help
		  "\n    Internet address is a string of at most four "
		  "decimal numbers separated by dots. For example, "
		  "\"130.233.161.40\" is a valid internet address.\n"
		  "    You will be asked again for the address, "
		  "if the address you entered is invalid.")))
      ;; loop while answer is unacceptable
      (if ::ask-ip-result
	  (NOT (patmatch "# #(1|2|3|4|5|6|7|8|9|0).#(1|2|3|4|5|6|7|8|9|0|.)# "
			 ::ask-ip-result))
	 ::ask-ip-need)))
 ::ask-ip-result)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 check-system-version
 ;; is your Exec recent enough?
 (set exec-version (/ (getversion) 65536))
 (transcript "Running on exec version " exec-version ".")
 (if (< exec-version need-version)	; check operating system version
     ((message @app-name " needs at least Exec version " need-version
	       " to run.\nYou have only version " exec-version ".\n"
	       "You can proceed with the installation, but consider "
	       "installing the " @app-name " with proper version of "
	       "the operating system."
	       (help
		"    The " @app-name " uses some system functions "
		"that are not present or functional in earlier system "
		"versions. Consider updating your system.\n"
		"    If you have a later version of operating system "
		"and are only now using older version: be sure to use "
		"only release 2.04 or newer with " @app-name ". "
		"No damage happens if you run " @app-name " with an "
		"earlier operating system, however. It just "
		"refuses to start.\n"
		"    If you decide to continue, no changes will be made to "
		"system startup files, so you must edit them yourself. "
		"Refer instructions for manual installation."))
      (transcript "User decided to continue installation while running "
		  "on operating system release earlier than 2.04."))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 check-available-memory
 ;;
 (transcript "Checking available memory.")
 (set avail-mem (+ (database "total-mem")))
 (if (< avail-mem need-memory)
     ((message "Your system has only " (/ avail-mem 1024) " kilobytes of "
	       "free memory, while " @app-name " needs at least "
	       (/ need-memory 1024) " to be useful.\n"
	       "You can continue the installation but be warned!")
      (transcript "User decided to continue installation while available "
		  "memory was below the recommended minimum."))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 check-user-level
 ;;
 (transcript "Checking user level.")
 (if (< @user-level 1)
     ((transcript "Installation aborted due to too low user level.")
      (abort "AmiTCP/IP installation requires at least the \"average\" "
	     "user level. Restart installation and select appropriate user "
	     "level."))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 select-destination-directory
 ;; Select destination directory for the installation. We suggest the user
 ;; to install to the place from where the installer was started. This is
 ;; since normally this software will be unarchived to its proper location
 ;; and the files don't have to be copied any more.
 ;;
 (transcript "Selecting destination directory for the installation.")
 (while
     ((set @default-dest
	   (askdir
	    (prompt "Select directory where to install " @app-name ".\n"
		    "Most of the files don't have to be copied, if you accept "
		    "the offered default.")
	    (help "    Here you can specify location where to install "
		  "the " @app-name ".\n"
		  "    Installation can be made on-place. "
		  "This is recommended if you have already unarchived "
		  "the " @app-name " archive to its final location. "
		  "In this case "
		  "most of the files are left where they are. "
		  "Only necessary files are copied to different "
		  "positions.\n"
		  "    Installation must NOT be made on top of the 1.0 "
		  "version of the " @app-name)
	    (newpath)
	    (default source-dir)))
      (if (= 2 (exists @default-dest))
	  ;; check that installation is not tried over the old version
	  (if (OR (exists (tackon @default-dest "bin/AmiTCP")) ; version 1.0
		  (> (getversion (tackon source-dir "AmiTCP"))
		     (if (exists (tackon @default-dest "AmiTCP"))
			 (getversion (tackon @default-dest "AmiTCP"))
		       $7FFFFFFF)))
	      ((message "You are possibly trying to install " @app-name " "
			"over an old version of it.\n"
			"It is not allowed.\n"
			"You should select some other directory or abort "
			"the installation.")
	       1)
	    0)
	((makedir @default-dest
		 (infos))
	 0))))

 ;; Make the AmiTCP: assign
 (makeassign atcp-name @default-dest))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 copy-files-to-destination ;;; Copy all files if not installing on-place
 ;;
 (if (= source-dir
	(expandpath @default-dest))
     (message "Source and destination directories are the same, "
	      "not copying."
	      (help "    The " @app-name " files don't have to be copied, "
		    "since the source and destination directory are "
		    "the same"))
   ((transcript "Copying " @app-name " files from " source-dir " to "
		@default-dest ".")
    (set dir-information
	 (cat 
	  (if (exists "src") "src - AmiTCP/IP source code\n" "")
	  (if (exists "netinclude") 
	      (cat "netinclude - include files needeed for networking "
		   "applications development\n") "")
	  (if (exists "netlib")
	     "netlib - link libraries for networking applications development\n"
	    "")
	  (if (exists "util") "util - source code for applications and utilities\n"
	    "")
	  (if (exists "devs") "devs - SANA-II device drivers\n" "")))
    (if (< 0 (strlen dir-information))
	(if (askbool (prompt "Do you want directories needeed only with "
			     "development of " @app-name " or applications "
			     "to be copied?")
		     (help "    These directories (and their contents) is "
			   "not needeed with normal use of AmiTCP/IP. "
			   "You need to copy them only when you plan to "
			   "do development.\n"
			   "    Description of directories:\n"
			   dir-information
			   (if (= @user-level 1)
			       "    If you select EXPERT level at start, you "
			     "    You ")
			   "will be prompted for each directory.\n"))
	    (foreach source-dir dir-pat-opt
		     ((set dest-dir (tackon @default-dest @each-name))
		      (if (NOT (exists dest-dir))
			  (makedir dest-dir))
		      (copyfiles 
		       (source source-dir)
		       (choices (fileonly @each-name))
		       (confirm)
		       (dest dest-dir)
		       (prompt 
			(if (= @user-level 1)
			    "Copying files to selected location."
			  "Copy this directory?"))
		       (help "    Description of directories:\n"
			     dir-information)
		       (optional "askuser"))))))
    (foreach source-dir dir-pat
	     ((set dest-dir (tackon @default-dest @each-name))
	      (if (NOT (exists dest-dir))
		  (makedir dest-dir))
	      (copyfiles (all)
			 (source (expandpath @each-name))
			 (dest dest-dir)
			 (prompt "Copying files to the selected location.")
			 (optional "askuser"))))
    (copyfiles (source source-dir)
	       (dest @default-dest)
	       (prompt "Copying files to the selected location.")
	       (pattern "#?")
	       (files)
	       (infos)
	       (optional "askuser"))))
 ;;
 ;; Add script flags to the ARexx scripts
 ;;
 (protect (tackon bin-dir "netstat") "+s +e"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-hostname ;; Get host name and default domain
 ;;
 (procedure
  setenv-hostname ;; Store hostname to the environment variable
  ;;
  ;; Tell the user that the environment variable HOSTNAME will be used.
  ;;
  (if 
      (askbool
       (prompt "The host name \"" my-full-name "\" will be stored to the "
	       "environment variable HOSTNAME where networking code "
	       "assumes it to be found.\n"
	       "This can be done in two ways: Either the variable is "
	       "stored to the ENV: and ENVARC: or a \"setenv\" command "
	       "is put to the s:user-startup.\n\n"
	       "Choose which to do:")
       (choices "Store to ENV(ARC):" "Use \"setenv\"")
       (default 1)
       (help "    This variable must be set for the applications "
	     "to work correctly.\n"
	     "    The ENVARC: is the standard place to store environment "
	     "variables which must not peridh on a re-boot. "
	     "Select \"setenv\" only if you are sure that it is needed."))
      ((set use-setenv-to-set-hostname 0)
       (if (= 2 (exists "ENV:"))
	   (textfile (dest "ENV:HOSTNAME")
		     (append my-full-name)))
       (if (= 2 (exists "ENVARC:"))
	   (textfile (dest "ENVARC:HOSTNAME")
		     (append my-full-name))))
    ;; this variable will be used when the user-startup is updated
    (set use-setenv-to-set-hostname 1)))
 ;;
 ;; Get the hostname from environment variable
 ;;
 (set def-full-name (if (exists "ENV:HOSTNAME") 
			(getenv "HOSTNAME")
		      "")
      my-host-name ""
      my-domain-name "")
 ;;
 ;; Break the name into the host and domain parts
 ;;
 (set ::index 0
      ::length (strlen def-full-name))
 (while (AND (< ::index ::length)
	     (NOT (= (substr def-full-name ::index 1) ".")))
   (set ::index (+ ::index 1)))
 (if (= ::index ::length)
     (set def-host-name ""
	  def-domain-name "")
   (set def-host-name (substr def-full-name 0 ::index)
	def-domain-name (substr def-full-name (+ ::index 1))))
 ;;
 ;; Ask the host name from the user
 ;;
 (while (OR (= my-host-name "")
	    ;; check that name has no dots
	    ((set ::index 0
		  ::length (strlen my-host-name))
	     (while (AND (< ::index ::length)
			 (NOT (= (substr my-host-name ::index 1) ".")))
	       (set ::index (+ ::index 1)))
	     (NOT (= ::index ::length))))
   (set my-host-name
	(askstring
	 (prompt
	  (cat "Enter the host name of your computer (not including "
	       "domain)"
	       (if (= my-host-name "")
		   ":"
		 (cat ".\nThe value " my-host-name " is illegal, since it "
		      "contains a dot."))))
	 (help net-setup-help
	       "    Host name is a string NOT containing dots (.), "
	       "example: \"my-amiga\".\n"
	       "    Domain specifies the administrative domain of the "
	       "network where your host is connected. For example, "
	       "\"hut.fi\" is the domain name of the Helsinki "
	       "University of Technology in Finland.\n")
	 (default def-host-name))))
 ;;
 ;; ask the domain name from the user
 ;;
 (while (= my-domain-name "")
   (set my-domain-name
	(askstring
	 (prompt "Enter the domain part of your host name:")
	 (help net-setup-help
	       "    Domain specifies the administrative domain of the "
	       "network where your host is connected. For example, "
	       "\"hut.fi\" is the domain name of the Helsinki "
	       "University of Technology in Finland.\n")
	 (default def-domain-name))))
 (set my-full-name (cat my-host-name "." my-domain-name))
 (setenv-hostname))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-aliases
 ;;
 (set my-host-aliases my-host-name)
 (while
     (set new-host-name
	  (askstring
	   (prompt "Give aliases to your computer " my-full-name
		   " one at a time."
		   (if my-host-aliases
		       (cat "\n\nAliases are:\n" my-host-aliases)))
	   (default (if my-host-aliases "" my-host-name))
	   (help net-setup-help
		 "    Your computer may have additional names "
		 "(aliases) to its official name. It is a customary "
		 "to have at least one alias, which "
		 "is the official host name without the domain part.\n")))
   (set my-host-aliases (cat my-host-aliases " " new-host-name))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-domains
 ;;
 (set domain-list ""
      text-domain-list "")
 (while
     (set domain
	  (askstring
	   (prompt
	    "Give domain names (one at a time) to search.\n"
	    "Press proceed after you have given each domain.\n"
	    "Give empty domain after you have finished.\n"
	    (if text-domain-list
		(cat "\nIncluded domains are:"
		    text-domain-list)))
	  (help
	   net-setup-help
	   "    In many environments more than one search domain "
	   "is needed for name resolution.\n"
	   "    For example, most of computers in the Helsinki "
	   "University of Technology are under single domain: "
	   "\"hut.fi\", so the full name of computer named "
	   "\"vipu\" would be \"vipu.hut.fi\". If the default "
	   "domain is \"hut.fi\", then this computer can be "
	   "referred without the domain part of the name (just "
	   "\"vipu\"). However, the computer science department "
	   "has its own domain \"cs.hut.fi\". When computers of "
           "the computer science department "
	   "are referred, the full name must be supplied, e.g. "
	   "\"colossus.cs.hut.fi\". This can be avoided by "
	   "providing \"cs.hut.fi\" as a secondary search domain. "
	   "The domains are searched in the given order. It is "
	   "fastest to give the most used domain first.\n"
	   "    In Unix systems the domain names are "
	   "usually stored into the file `/etc/resolv.conf`.\n")
	  (default (if domain-list "" my-domain-name))))
  (set domain-list ("%sDOMAIN %s\n" domain-list domain)
       text-domain-list (cat text-domain-list "\n" domain)
       default-domain "")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 update-devices
 (transcript "Updating Sana-II device drivers.")
 ;;
 ;; Create directory DEVS:Networks if it does not exist already
 ;;
 (if (NOT (= 2 (exists "DEVS:Networks")))
     (makedir "DEVS:Networks"))
 ;;
 ;; Copy each driver in the distribution to the DEVS:Networks if necessary
 ;;
 (working "Checking Sana-II device drivers...")
 (set dist-networks-dir (tackon source-dir "devs/networks"))
 (if (= 2 (exists dist-networks-dir))
     (foreach
       dist-networks-dir "#?.device"
       ((set dist-name (tackon dist-networks-dir @each-name)
	     devs-name (tackon "DEVS:Networks" @each-name)
	     dist-version (getversion dist-name)
	     copy-it (NOT (exists devs-name)))
	;;
	;; Check if the driver should be copied over
	;;
	(if (NOT copy-it)
	    (set copy-it 
	             ; or if the driver in DEVS:Networks is of older version
		 (< (set devs-version (getversion devs-name)) dist-version)))
	(if (NOT copy-it)
	    (set copy-it 
		     ; or if the files are of the same version but different
		 (set sum-differs (if (= dist-version devs-version)
				      (<> (getsum dist-name)
					  (getsum devs-name))
				    0))))
	(if copy-it
	    (copyfiles 
	     (prompt "Confirm the copy.\n"
		     (if devs-version
			 (cat "A driver with the same name exists already"
			      (if sum-differs
				  (cat ", it has the same version, but the "
				       "files are not the same.")
				(cat ", but the driver in the "
				     "DEVS:Networks is of older version.")))
		       ""))
	     (help 
	      "    The Sana-II drivers should be located in "
	      "the DEVS:Networks directory.\n"
	      "    This directory is the official location for the SANA-II "
	      "device drivers. Some other software may be able to use the "
	      "drivers, if they are copied over.")
	     (source (pathonly dist-name))
	     (choices (fileonly dist-name))
	     (dest "DEVS:Networks")
	     (files)
	     (optional "nofail" "askuser")
	     (confirm "average"))))))

 ;;; ask user which env/sana2 files should be copied
 (if (= 2 (exists (tackon source-dir "env/sana2")))
     (if
	 (askbool (prompt "Do you want to install example Sana-II "
			  "configuration files?\n"
			  "Copies will be confirmed.")
		  (help "    This release contains example configuration "
			"files for the SLIP devices and Agnet (a Sana-II "
			"pseudo device).\n"
			"    The copying of each file will confirmed.")
		  (default 1))
	 (copyfiles 
	  (prompt "Select Sana-II configuration files to be copied:")
	  (help "    These configuration files are for example only. "
		"You need to edit them for them to be useful. Refer to "
		"the documentation of the Sana-II device in question. "
		"The AmiTCP:doc directory contains documentation for "
		"the drivers included in this release.\n"
		"    The files will be copied to the ENVARC: by default. "
		"Normally they will be copied to ENV: on next reboot.")
	  (source (tackon source-dir "env/sana2"))
	  (dest "ENVARC:sana2")
	  (all)
	  (files)
	  (optional "nofail" "askuser")
	  (confirm "average")))
   ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Ask network interfaces
;;;
;;; Loop until no device is given.
;;;
(procedure
 ask-interfaces
 ;;
 ;; Procedure to ask the network device driver name
 ;;
 ;; (Returns TRUE if an interface file exists..)
 ;;
 (procedure
  if-ask-device
  (while
      ((set my-host-if
	    (askfile
	     (prompt
	      "Select a SANA-II device driver. If you have set "
	      "up all your interfaces, just press proceed.")
	     (default "Devs:Networks")
	     (help
	      "    Select the name of a SANA-II device to be used, "
	      "like \"a2065.device\" or \"slip.device\" for the "
	      "A2065 ethernet adapter or SLIP driver, respectively.\n"
	      "    Primary address of your computer is the one "
	      "with which your computer will most often be referenced.\n"
	      "    If you are going to attach your computer to "
	      "several networks (by using many network "
	      "adapters), different address must be assigned to "
	      "each adapter.\n"
	      "    When you have configured all your network "
	      "interfaces, select no file to continue. This can be done by "
	      "entering nothing to the \"file\" gadget.")))
       ;;
       ;; Try to ensure that we get at least 1 SANA-II network interface
       ;;
       (if (AND (= address-list "")
		(= 2 (exists my-host-if)))
	   (askbool
	    (prompt
	     "You have not defined any SANA-II network interface for "
	     "the " @app-name ". You should define at least one "
	     "external interface. It is crucial for the correct "
	     "operation even if you are using " @app-name " "
	     "locally with internal loopback device.\n"
	     "    For the moment you can give "
	     "the interface a random IP address (eg. 126.1). "
	     "Reinstall " @app-name " when you get a real "
	     "network connection.\n\n"
	     "Do you want to define a network interface for "
	     @app-name "?")
	    (help
	     "    Each IP packet must be given a source address. "
	     "AmiTCP/IP stamps each packet which it sends with an "
	     "address of some external interface. "
	     "Because of an internal design of the AmiTCP/IP, "
	     "the source address can not be local. (Local address is "
	     "any address configured to the internal loopback "
	     "interface, normally 127.1).\n")))))
  ;; If user gives no file, a directory is actually given
  (if (= 2 (exists my-host-if))
      ""
    my-host-if))

 ;;
 ;; Ask for the unit number
 ;;
 (procedure
  if-ask-unit
  (set my-host-if-unit
       (asknumber
	(prompt "Select unit number for the " my-host-if ":")
	(default 0)
	(help "    Select the unit number for the SANA-II device driver "
	      my-host-if " to use. This is usually 0 for the first "
	      "unit of that particular device. "
	      "Refer your device driver documentation for "
	      "correct number to use."))))

 ;;
 ;; Ask for the IP address of this host
 ;;
 (procedure
  if-ask-address
  (set ::ask-ip-prompt (cat "IP address for the interface " my-host-if 
			    "/" my-host-if-unit ".\n"
			    "Each interface must have an unique\n"
			    "Internet Protocol address.")
       ::ask-ip-help (cat "    If you have no actual network connection, "
			  "you may give a nonexistent IP number for "
			  "your external interface.")
       ::ask-ip-need 1
       my-host-addr (ask-ip-address)))

 ;;
 ;; Ask for the optional destination address
 ;;
 (procedure
  if-ask-dest-address
  (set ::ask-ip-prompt (cat "Give the destination address for the "
			    my-host-if "/" my-host-if-unit ".\n"
			    "Address of interface is " my-host-addr ".\n" 
			    "This is should give the destination address "
			    "ONLY if you have a point-to-point interface "
			    "(e.g. SLIP). You should give NO destination "
			    "address for broadcast interface (e.g. Ethernet)."
			    "\n")
       ::ask-ip-help (cat
		      "    A point-to-point device is one that is connected"
		      " to a medium which only two devices can attach, for "
		      "example the normal serial line: your computer is in "
		      "other end and the other computer is on the other "
		      "end (maybe via modem, that does not change it).\n"
		      "    Ethernet, for example, is not a "
		      "point-to-point device because several devices "
		      "can connect to single physical medium.")
       ::ask-ip-need 0
       dest-host (ask-ip-address)))

 ;;
 ;; Ask for the netmask for this interface. If nothing is given,
 ;; a default value will be used by the ifconfig.
 ;;
 (procedure
  if-ask-netmask
  (set ::ask-ip-prompt (cat "Netmask of network on interface " my-host-if 
			    "/" my-host-if-unit ".\n"
			    "Address of interface is " my-host-addr
			    (if dest-host
				(cat ",\ndestination address is " dest-host ".\n")
			      (cat ".\n")))
       ::ask-ip-help (cat "    Netmask is a dot separated string of four "
			  "decimal numbers (similar "
			  "to an internet address), which specifies which "
			  "bits of the host address are used as the "
			  "network address.\n"
			  "    For example, \"255.255.255.0\" "
			  "is a possible netmask.\n"
			  "    The netmask must be same for all interfaces "
			  "connected to the same network.\n"
			  "    If you do NOT give a netmask (i.e. leave it "
			  "empty), it will be computed from your interface "
			  "address. This is correct only if the network "
			  "is not divided into subnets.")
       ::ask-ip-need 0
       my-host-netmask (ask-ip-address)))

 ;;
 ;; Ask for confirmation on given information
 ;;
 (procedure
  if-confirmation
  (askbool
   (prompt "This is the information you gave for this interface:\n"
	   "\nSANA-II driver: " my-host-if
	   "\nUnit number: " my-host-if-unit
	   "\nInterface address: " my-host-addr
	   "\nDestination address: " (if (= dest-host "") "<none>"
				       dest-host)
	   "\nNetmask: " (if (= my-host-netmask "") "<use default>"
			   my-host-netmask)
	   "\n\nIs this correct?")
   (help "    Check the information shown. If you do not confirm it, "
	 "all of it will be asked again.")))

 ;;
 ;; Set startup string to contain configuration for the loopback device
 ;; (Other information will be later appeneded to this string variable).
 ;;
 (set su-script
      (cat "; configure loop-back device\n"
	   (tackon bin-dir "ifconfig") " lo/0 localhost\n")
      ;; a complete list for IP address to host name mappings..
      address-list "")
 ;;
 ;; Ask for interfaces
 ;;
 (while
     (if-ask-device)
   (if-ask-unit)
   (if-ask-address)
   (if-ask-dest-address)
   (if-ask-netmask)
   (if (if-confirmation)
       ((transcript "Adding interface " my-host-if "/" my-host-if-unit )
	(set
	 ;; Add this interface to the script string
	 su-script 
	 (cat su-script
	      "; Configure " my-host-if " unit " my-host-if-unit "\n"
	      (tackon bin-dir "ifconfig") " "
	      my-host-if "/" my-host-if-unit " " my-host-addr " "dest-host
	      (if my-host-netmask
		  (cat " netmask " my-host-netmask))
	      "\n")
	 ;; Add IP address entry for this IP number
	 address-list
	 (cat address-list
	      "HOST " my-host-addr " " my-full-name " " my-host-aliases "\n")
	 )))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-gateway ;;; Ask the default gateway address
 ;;
 (set ::ask-ip-prompt "Enter the IP address of the default gateway:"
      ::ask-ip-help (cat
		     "    All network packets for destinations for which "
		     "there is no defined route, are sent to the default "
		     "gateway, which (hopefully) can send them towards "
		     "the destination host.\n"
		     "    The IP address (instead of a name) is needed, "
		     "because the name may not be resolved without the "
		     "gateway, if the name server is not "
		     "in your local network.")
      ::ask-ip-need 0
      def-gateway-addr (ask-ip-address))
 ;;
 (set su-script
      (cat su-script
	   "; Add route to this host\n"
	   (tackon bin-dir "route") " add " my-full-name " localhost\n"
	   (if def-gateway-addr
	       (cat "; Add route to the default gateway\n"
		    (tackon bin-dir "route")
		    (" add default %s\n" def-gateway-addr))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-nameservers ;;; Ask addresses to the name servers
 ;;
 (set name-server-list ""
      name-server-text-list "")
 (while
     (set ::ask-ip-prompt
	  (cat "Enter the IP addresses of the name servers (one at a time). "
	       "The name servers will be searched in the given order.\n"
	       (if name-server-text-list
		   ("\nIncluded name servers are: %s\n"
		    name-server-text-list)))
	  ::ask-ip-help
	  (cat "    A name server is used to resolve host "
	       "names to internet addresses. This allows you "
	       "to use symbolic names for the hosts instead "
	       "of internet addresses.\n"
	       "    In Unix systems the name server addresses are "
	       "usually stored into the file `/etc/resolv.conf`.\n")
	  ::ask-ip-need 0
	  name-server-addr (ask-ip-address))
   (set name-server-list (cat name-server-list 
			      "NAMESERVER " name-server-addr "\n")
	name-server-text-list (cat name-server-text-list "\n" 
				   name-server-addr))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 create-config-file
 ;;
 (textfile (dest (tackon conf-dir "netdb-myhost"))
	   (append
	    (if address-list (cat "; This host\n" address-list)))
	   (append
	    (if domain-list (cat "; Domain names\n" domain-list)))
	   (append
	    (if name-server-list (cat "; Name servers\n" name-server-list)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 create-startup-script
 ;;
 ;; Create the network startup-script (AmiTCP:bin/startnet)
 ;;
 (textfile (dest (tackon bin-dir "startnet"))
	   (append
	    "run AmiTCP:AmiTCP\n"
	    "SYS:Rexxc/WaitForPort AMITCP\n"
	    "Wait 2 secs\n")
	   (append su-script)
	   (append 
	    (if (askbool 
		 (prompt "Do you want the Inetd to be started at the "
			 @app-name " startup?\n")
		 (help "    Inetd is the Internet `Super Server', which "
		       "listens for connections on behalf of other "
		       "servers. When a connection request for a port, "
		       "for which Inetd is configured to listen, arrives "
		       "Inetd accepts the connections and starts the "
		       "server in question.\n"
		       "    The file " (tackon conf-dir "inetd.conf")
		       " contains the configuration information for the "
		       "Inetd, which you will want to edit.\n"
		       "    Currently only finger daemon is distributed "
		       "with " @app-name ".\n"
		       "    Refer to the documentation for more information."))
		(cat "; Start the internet `super server'\n"
		     "run AmiTCP:bin/inetd\n")
	      "\n")))
 (protect (tackon bin-dir "startnet") "+s +e"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 update-user-startup
 ;;
 (set to-be-added-to-startup
      (cat (if use-setenv-to-set-hostname
	       (cat "setenv HOSTNAME " my-full-name "\n")
	     "")
	   "assign " atcp-assign " " @default-dest "\n"
	   "path " bin-dir " add\n"
	   (if (askbool
		(prompt
		 "Do you want the " @app-name
		 " to be started at the system startup?")
		(help
		 "    If you decide not to start " @app-name " at startup, "
		 "you can later start it by giving command\n\n"
		 "run " (tackon bin-dir "startnet")
		 "\n\n at the command shell."))
	       ((set started-at-boot 1)
		(cat "run " (tackon bin-dir "startnet\n")))
	     ((set started-at-boot 0)
	      ""))
	   (if (AND
		(= 2 (exists include-dir))
		(= 2 (exists lib-dir)))
	       (if (askbool
		    (prompt "Do you want to add assigns to "
			    "netinclude and netlib directories?")
		    (help "    These assigns are only needed for compiling "
			  "programs using the " @app-name "."))
		   (cat "; assigns for programmers\n"
			"assign netinclude: " include-dir "\n"
			"assign netlib: " lib-dir "\n"))))
      complete-to-be-added-to-startup (cat ";BEGIN " @app-name "\n"
					   to-be-added-to-startup
					   ";END " @app-name "\n"))
 ;; Ask for confirmation to add
 (if (>= exec-version 37)
     (if 
	 (askbool
	  (prompt "Do you want Installer to make the required changes to "
		  "your s:user-startup script?\n"
		  "\n(There is a problem with Installer making these "
		  "changes if you do not have the original boot volume "
		  "mounted. Installer may crash or corrupt your system "
		  "in that case.)")
	  (help "If you do not want Installer make the changes, it will "
		"create a script file containing commands which you should "
		"add to the s:user-startup file."))
	 ;; Do the addition
	 (startup
	  @app-name
	  (command to-be-added-to-startup)
	  (prompt "Installer will modify your S:User-Startup file. "
		  "Following lines will be appended to it:\n\n"
		  complete-to-be-added-to-startup)
	  (help "   Installer needs to make indicated modifications to "
		"your user startup file to make sure that everything is "
		"correctly set up to run " @app-name ".\n"
		"   You should make modifications later by hand "
		"if you skip this part."))
       ;; Let user add commands
       ((set addition-to-user-startup
	     (tackon atcp-assign "addition-to-user-startup"))
	(textfile (dest addition-to-user-startup)
		  (append complete-to-be-added-to-startup))
	(message "Installer created file " addition-to-user-startup 
		 ", which you can add to your startup file by hand. "
		 "The file includes following changes:\n\n"
		 complete-to-be-added-to-startup)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 install-emacstcp
 ;; is GNU Emacs is installed?
 (if (exists "GNUEmacs:" (noreq)) ; check if GNUEmacs is installed
     (if (exists (tackon source-dir "util/EmacsTCP"))
	 ((transcript "Installing EmacsTCP.")
	  (copyfiles
	   (source (tackon source-dir "util/EmacsTCP/lisp"))
	   (prompt "Copying GNU Emacs lisp files to GNUEmacs:lisp")
	   (help "   Emacs lisp files implement the Emacs side of the "
		 "Gnu Emacs TCP support.")
	   (pattern "tcp.el#?")
	   (dest "GNUEmacs:lisp")
	   (optional "nofail" "askuser")
	   (confirm))
	  (copyfiles
	   (source (tackon source-dir "util/EmacsTCP/etc"))
	   (choices "tcp_AmiTCP")
	   (prompt "Copying tcp_AmiTCP (program) to GNUEmacs:etc")
	   (help "   tcp_AmiTCP implements the " @app-name " side of the "
		 "Gnu Emacs TCP support.")
	   (dest "GNUEmacs:etc")
	   (optional "nofail" "askuser")
	   (confirm))
	  (if (exists "GNUEmacs:etc/tcp_AmiTCP") 
	      (protect "GNUEmacs:etc/tcp_AmiTCP" "+p")) ; tcp is pure
	  ;; Tell user what to do with .emacs
	  (run "run ram:more" 
	       (tackon source-dir "util/EmacsTCP/add_to_.emacs") 
	       (safe)))
       (message "EmacsTCP not present in " source-dir "."))
   (message "GNU Emacs must be installed before EmacsTCP.")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-install-emacstcp
 ;; is GNU Emacs is installed?
 (if (exists "GNUEmacs:" (noreq)) ; check if GNUEmacs is installed
     (if (exists (tackon source-dir "util/EmacsTCP"))
	 (if (askbool
	      (prompt "Do you want to install needed files for GNU Emacs "
		      "support?")
	      (help
	       "    Installer has noticed that you have GNUEmacs: assigned "
	       "in your system. Normally this means that you have the "
	       "GNU Emacs installed.\n"
	       "    AmiTCP/IP provides an Emacs extension, which makes "
	       "it possible to run networking programs with it. To enable "
	       "this feature some files need to be installed "
	       "in to directories under \"GNUEmacs:\".\n"
	       "    If you select \"Yes\", files will be installed and you "
	       "will be able to use TCP/IP applications written for "
	       "GNU Emacs."))
	     (install-emacstcp)
	   (transcript "User denied adding AmiTCP/IP support for GNU Emacs."))
       (transcript "EmacsTCP not present on " source-dir "."))
   (transcript "No GNU Emacs detected in system.")))
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 install-napsaterm
 ;; Ask for directory to install fonts.
 ;; (not functional yet)
 (procedure
  ask-napsa-font-dir
  (askdir
   (prompt "Select directory where to install Napsaterm fonts.\n")
   (help "    Here you can specify location where to install "
	 "the Napsaterm font called `napsa'. "
	 "This directory should be in your font path "
	 "(i.e. some directory in assign fonts:).")
   (newpath)
   (default "fonts:")))
 ;; currently, use this
 (procedure do-not-ask-napsa-font-dir "fonts:")
 ;; Install Napsaterm?
 (if (= 2 (exists (tackon source-dir "napsaterm")))
     ((transcript "Installing Napsaterm binary, preferences and fonts.")
      (if (NOT (exists (tackon bin-dir "napsaterm")))
	  (copyfiles
	   (source (tackon source-dir "napsaterm/napsaterm"))
	   (prompt "Copying Napsaterm program to AmiTCP:bin")
	   (optional "nofail")
	   (dest bin-dir)))
      (copyfiles
       (source (tackon source-dir "napsaterm/napsaprefs"))
       (prompt "Copying Napsaterm preferences to S:")
       (dest "S:")
       (optional "nofail" "askuser"))
      (copyfiles
       (source (tackon source-dir "napsaterm/fonts"))
       (prompt "Copying font `napsa' to " napsa-font-dir ".")
;       (dest (do-not-ask-napsa-font-dir))
       (dest (ask-napsa-font-dir))
       (optional "nofail")
       (fonts)
       (all))
      ;; Napsaterm is pure
      (protect (tackon bin-dir "napsaterm") "+p")
      (if (AND (= (exists (tackon source-dir "napsaterm/src")) 2)
	       (<> (tackon source-dir "napsaterm")  ;; and in different directory
		   (tackon (expandpath @default-dest) "napsaterm")))
	  (if 
	      (askbool
	       (prompt "Do you want to install Napsaterm sources as well?")
	       (help "    Napsaterm sources are provided "
		     "to you so you can improve and change it "
		     "as long as you leave the original "
		     "copyright notices intact."))
	      ((transcript "Installing Napsaterm sources.")
	       (if (<> (exists (tackon @default-dest "napsaterm")) 2)
		   (makedir
		    (tackon @default-dest "napsaterm")
		    (prompt "Creating " @default-dest 
			    "napsaterm directory.")))
	       (if (<> (exists (tackon @default-dest "napsaterm/src")) 2)
		   (makedir
		    (tackon @default-dest "napsaterm/src")
		    (prompt "Creating " @default-dest 
			    "napsaterm/src directory")))
	       (copyfiles
		(source (tackon source-dir "napsaterm/src"))
		(prompt "Copying Napsaterm sources")
		(dest (tackon @default-dest "napsaterm/src"))
		(optional "nofail")
		(all))))))
   (message "NapsaTerm not present on " source-dir)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-install-napsaterm
 ;; Install Napsaterm?
 (if (= 2 (exists (tackon source-dir "napsaterm")))
     (if (askbool
	  (prompt "Do you want to install Napsaterm?")
	  (help "    Napsaterm is a VT102 terminal emulator "
		"which uses the rlogin protocol. "
		"You can have a remote login to many "
		"hosts in Internet with Napsaterm.\n"
		"    Napsaterm is based on the Niftyterm 1.2 written by "
		"Todd Williamson and Christopher J. Newman."))
	 (install-napsaterm))
   (transcript "NapsaTerm not present on " source-dir)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Installatation sequence
;;;
(complete 00) (transcript "On making " @app-name ".")
(complete 01) (check-user-level)
(complete 02) (check-system-version)
(complete 03) (check-available-memory)
(complete 05) (select-destination-directory)

(if (exists (tackon conf-dir "netdb-myhost"))
    ( ;; Already configured, ask user what s/he wants to do
     (transcript @app-name " already configured, presenting options")
     (while
	 ((complete 10)
	  (set choice
	       (askchoice
		(prompt @app-name " seems to be already installed. Select "
			"one of following:")
		(help "    Installer has detected that the file "
		      "\"AmiTCP:db/netdb-myhost\" exists already. Normally "
		      "this means that the installation has been "
		      "successfully completed.\n"
		      "    You can now select what part of the full "
		      "installation you want to repeat. This selection will "
		      "be repeatedly presented, until \"Done\" is choosed.")
		(choices "Update Sana-II drivers"	; 0
			 "Install EmacsTCP"		; 1
			 "Install NapsaTerm"		; 2
			 "Reconfigure AmiTCP/IP"	; 3
			 "Done")			; 4
		(default 4)))
	  (<> choice 4))
       (select choice
	       ;; (0)
	       (update-devices)
	       ;; (1)
	       (install-emacstcp)
	       ;; (2)
	       (install-napsaterm)
	       ;; (3)
	       ((transcript "Reconfiguring " @app-name ".")
		(complete 20) (ask-hostname)
		(complete 25) (ask-aliases)
		(complete 30) (ask-interfaces)
		(complete 65) (ask-gateway)
		(complete 70) (ask-domains)
		(complete 75) (ask-nameservers)
		(complete 85) (update-user-startup)
		(complete 90) (create-startup-script)
		(complete 95) (create-config-file) ; This must be the last one!
		))
       )
     )
  ( ;; First time installation, do it all
   (complete 10) (copy-files-to-destination)	; copy AmiTCP/IP files
   (complete 20) (update-devices)		; update Sana-II drivers
   (complete 30) (ask-install-emacstcp)		; install EmacsTCP
   (complete 40) (ask-install-napsaterm)	; install NapsaTerm

   ;; Configure AmiTCP/IP
   (complete 50) (ask-hostname)
   (complete 55) (ask-aliases)
   (complete 60) (ask-interfaces)
   (complete 75) (ask-gateway)
   (complete 80) (ask-domains)
   (complete 85) (ask-nameservers)
   (complete 90) (update-user-startup)
   (complete 95) (create-startup-script)
   (complete 96) (create-config-file)		; This must be the last one!
   ;; show something
   (run "run ram:more" (tackon atcp-assign "README.FIRST") (safe))
   )
  )
;;; All done!
(complete 100)
(exit "You should reboot your Amiga to make sure that everything is set "
      "up properly for the " @app-name ". After the reboot, "
      (if started-at-boot
	  (cat @app-name " should be running. If this is not a case, "))
      "type \"run AmiTCP:bin/startnet\" in a command shell to start "
      @app-name ".")