;;;; Hey Emacs, this script might as well be -*- lisp -*-
;;;;
;;;; Install_AmiTCP - AmiTCP/IP installation script for Installer
;;;;
;;;; Copyright  1994 AmiTCP/IP Group,
;;;;                  NSDi - Network Solutions Development Inc., Finland
;;;;                  All rights reserved.
;;;;
;;;; $Id: Install_AmiTCP,v 4.14 1994/10/24 20:57:34 jraja 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 the " @app-name " 4.0 demo version installation.\n")
;;;;
;;;; What we are?
;;;;
(set app-name (cat @app-name " 4.0 demo version"))

;;;;
;;;; "Needs"
;;;;
(set need-version 37  ; version of operating system need by AmiTCP/IP
     need-memory (* 512 1024))
;;;
;;; Destination directories of the AmiTCP/IP
;;;
(set 
 atcp-name "AmiTCP"
 atcp-assign (cat atcp-name ":")	; Assign to AmiTCP
 ;; Exported files
 export-dir (tackon atcp-assign "export")
 ;; Configuration
 conf-dir (tackon atcp-assign "db")
 ;; User binaries
 bin-dir (tackon atcp-assign "bin")
 ;; documentation
 doc-dir (tackon atcp-assign "doc")
 ;; devices directory
 devs-dir (tackon atcp-assign "devs")
 ;; AmigaGuide documentation
 help-dir (tackon atcp-assign "help")
 ;; DOS handlers
 l-dir (tackon atcp-assign "l")
 ;; libraries
 libs-dir (tackon atcp-assign "libs")
 ;; daemons
 serv-dir (tackon atcp-assign "serv")
 ;; source
 src-dir (tackon atcp-assign "src")
 ;; 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
 ;;
 ;; These directories are always present
 dir-pat (cat "(" "devs" "|" "db" "|" "bin" "|" "doc" "|" 
	      "help" "|" "l" "|" "libs" "|" "serv" ")")
 ;; Optional directories
 dir-pat-opt (cat "(" "netinclude" "|" "netlib" "|" "src" ")")
 ;;
 ;; The source directory name
 source-dir (if (= 1 (exists @icon))
		    (pathonly (expandpath @icon))
		  (expandpath @icon))
 ;;
 ;; directories in exports
 ;;
 dist-networks-dir (tackon source-dir "export/Devs/Networks")
 ;; Mounts
 tcp-mount (cat 
	    "Assign TCP: Exists > NIL:\n" 
	    "IF Warn\n"
	    "  Mount TCP: from AmiTCP:devs/Inet-Mountlist\n"
	    "EndIf\n")
 apipe-mount (cat 
	      "Assign APIPE: Exists > NIL:\n" 
	      "IF Warn\n"
	      "  Mount APIPE: from AmiTCP:devs/APipe-Mountlist\n"
	      "EndIf\n")
 )
 ;; 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
(set
 pager-cmd (if (exists "ENV:PAGER" (noreq)) (getenv "PAGER"))
 pager-cmd 
 (if pager-cmd pager-cmd 
   (if (exists "SYS:Utilities/More" (noreq))
       ((copyfiles
	 (prompt "Copying sys:utilities/more to ram: for use")
	 (source "SYS:Utilities/More")
	 (dest   "RAM:")
	 (safe)
	 (optional "nofail"))
	"RAM:More")
     ("more"))))

;; Return old AmiTCP: assign if we are aborting
(onerror
 (if old-atcp-directory
     (makeassign atcp-name old-atcp-directory)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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
 ;;  ::ask-ip-default  - default value for the asked IP address
 ;;
 ;; locally used names:
 ;;  ::ask-ip-result
 (set ::ask-ip-result "")
 (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 ::ask-ip-result
			(cat "\n\nYou entered an invalid value\n\""
			     ::ask-ip-result "\".\n"
			     "Enter a valid IP address.")))
	    (default ::ask-ip-default)
	    (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 "The " @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 the " @app-name ". "
		"No damage happens if you run the " @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 the " @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
 check-old-assign
 ;; If there is already the AmiTCP/IP installed, store the assign
 ;; to old-atcp-directory
 (transcript "Checking for already installed AmiTCP.")
 (if (exists atcp-assign (noreq))
     (set old-atcp-directory (getassign atcp-name)))
 (if old-atcp-directory
     (transcript "Existing AmiTCP detected at directory " 
		 old-atcp-directory ".")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-accept-licence ;; Ask if the user accepts licence conditions
 (transcript "Asking if the user accepts the licence conditions.")
;;
;; use "more" to show the full licence text
;;
 (run (cat "run " pager-cmd) (tackon source-dir "LICENCE") (safe))
 (message "\nAmiTCP/IP is a copyrighted propiertary software of "
	  "the Network Solutions Development Inc.\n"
          "\nPlease read the shown licence text carefully.\n"
          "\nBy proceeding the installation of this software you "
	  "indicate that you accept the licence conditions.\n"
	  )
 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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 the " 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 an older "
		  "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 the " @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 "\nSource and destination directories are the same, "
	      "not copying."
	      (help "    The " app-name " files don't have to be copied, "
		    "since the source and the destination directories are "
		    "the same."))
   ((transcript "Copying " app-name " files from " source-dir " to "
		@default-dest ".")
    (set dir-information
	 (cat
	  (if (exists "netinclude")
	      (cat "netinclude - include files needed for networking "
		   "applications development\n"))
	  (if (exists "netlib")
	     "netlib - link libraries for networking program development\n")
	  (if (exists "src")
	      (if (exists "src/util")
		  (cat "src - source code for libraries, examples"
		       "and all the binaries\n")
		"src - source code for the libraries and examples\n"))
	  ))
    (if (< 0 (strlen dir-information))
	(if (askbool
	     (prompt "\nDo you want directories needed only with development "
		     "for the " @app-name " or applications to be copied?")
	     (help "    These directories (and their contents) is "
		   "not needed to use AmiTCP/IP. "
		   "You need to copy them only when you plan to "
		   "make network programs by yourself.\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
	     (copyfiles
	      (source source-dir)
	      (choices (fileonly @each-name))
	      (confirm)
	      (dest @default-dest)
	      (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"))))
 ;;
 ;; Create AmiTCP:log if it does not exist already
 ;;
 (if (NOT (= 2 (exists (tackon atcp-assign "log"))))
     (makedir (tackon atcp-assign "log")))
 ;;
 ;; Create AmiTCP:log/wtmp if it does not exist already
 ;; (This is to avoid unnecessary errors from the ftpd)
 ;;
 (if (NOT (= 1 (exists (tackon atcp-assign "log/wtmp"))))
     (textfile (dest (tackon atcp-assign "log/wtmp"))))
 ;;
 ;; Add script flags to the scripts, pure flags to pure programs
 ;;
 (protect (tackon bin-dir "ch_nfsctl") "+s +e")
 (protect (tackon bin-dir "netstat") "+s +e")
 (protect (tackon bin-dir "SynClock") "+s +e")
 (protect (tackon bin-dir "stopnet") "+s +e")
 (if (exists src-dir)
     ((protect (tackon src-dir "compile") "+s +e")
      (protect (tackon src-dir "compile.lib") "+s +e")))
 (protect (tackon bin-dir "NapsaTerm") "+p +e")
 (protect (tackon serv-dir "in.fingerd") "+p +e")
 (if (exists (tackon bin-dir "rcsrev"))
     (protect (tackon bin-dir "rcsrev") "+p +e"))
 )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-slip-config
 ;;
 ;; the my-host-if has to be set before this is called
 ;;
 ;; This sets the if-config-file on return ("" if not applicaple).
 ;; The config file is returned without the path and it will be put to the 
 ;; ENV:Sana2 directory by the generated startnet script.
 ;; The contents is stored in if-config.
 ;;
 (transcript "Creating configuration file for SLIP/CSLIP devices.")
 ;;
 ;; Loop until the user is satisfied
 ;;
 (while
     ((set my-serial-device
	   (askfile (prompt "Select the SERIAL device driver to be used with "
			    my-host-if ":\n"
			    "NOTE: This list lists all devices in DEVS:.\n"
			    "Normally you would want to select "
			    "`serial.device'."
			    )
		    (default "DEVS:serial.device")
		    (help "    You should select the serial device driver to "
			  "be used for the transport of " my-host-if ". "
			  "You will be separately asked for the unit number.\n"
			  "    You can cancel this operation by giving an "
			  "empty string.")))
      (if (= 1 (exists my-serial-device))
	  ;;
	  ;; remove the prefix from the file name
	  ;;
	  ((if (patmatch "DEVS:#?" my-serial-device)
	       (set my-serial-device (substr my-serial-device 5)))
	   
	   (set my-serial-unit
		(asknumber
		 (prompt "\nSelect unit number for the " my-serial-device ":")
		 (default 0)
		 (help "    Select the unit number for the device "
		       my-serial-device " to use. This is 0 for the "
		       "internal serial port, but might be other for "
		       "other serial devices."))
		my-serial-baud
		(asknumber
		 (prompt "\nGive the baud rate for the " my-serial-device 
			 " unit " my-serial-unit ".\n"
			 "\nPlease start with a low value like 9600, "
			 "if you are not absolutely sure that your SLIP "
			 "line works at higher speeds.\n")
		 (default 9600)
		 (help "    The baud rate MUST match the one used while "
		       "dialling to the SLIP provider.\n"
		       "    Since higher speeds may have some problems, you "
		       "should always start with some reasonably low baud "
		       "rate (like 9600) and then, when your SLIP setup "
		       "works, try out the higher speeds."))
		my-slip-mtu-raw
		(asknumber
		 (prompt "\nGive the Maximum Transfer Unit (MTU) for the "
			 my-host-if ":\n")
		 (range 576 1500)
		 (default 1006)
		 (help "    The MTU MUST match the one used by your SLIP "
		       "provider.\n"
		       "    The value 1006 bytes is the most common, but 1500 "
		       "bytes is also used often.\n"
		       "    You should consult your SLIP provider for the "
		       "correct value to use."))
		;; Force the MTU to be even
		my-slip-mtu
		(* (/ (+ 1 my-slip-mtu-raw) 2) 2)
		my-slip-options-bitmap
		(askoptions
		 (prompt "\nSelect additional options to be used with the "
			 my-host-if ":\n"
			 "\nPlease see Help for explanations for each option.")
		 (choices "Carrier Detect" "Hardware-handshake (CTS/RTS)"
			  "EOF-mode")
		 (default %010)
		 (help "    Carrier Detect (CD): "
		       "If selected, causes the " my-host-if " to pay "
		       "attention to the status of the carrier detect line. "
		       "If this isn't selected, the CD signal will be "
		       "ignored.\n"
		       "    Hardware-handshake (7WIRE): "
		       "If selected, the seven wire (or hardware, i.e., "
		       "CTS/RTS) handshaking is used with the modem. "
		       "This option is strongly recommended for high baud "
		       "rates.\n"
		       "    EOF-mode (EOFMODE): "
		       "If selected, causes " my-host-if " to use EOFMODE. "
		       "This reduces the CPU load considerably, but it "
		       "won't work with all different (buggy) serial "
		       "devices (like the a2232)."))
		my-slip-options
		(cat (if (in my-slip-options-bitmap 0)
			 "CD ")
		     (if (in my-slip-options-bitmap 1)
			 "7WIRE ")
		     (if (in my-slip-options-bitmap 2)
			 "EOFMODE"))
		)
	   
	   (if (not (askbool
		     (prompt
		      "This is the information you gave for the configuration "
		      "for the " my-host-if ":\n"
		      "\nSerial device: " my-serial-device
		      "\nSerial unit: " my-serial-unit
		      "\nSerial baud rate: " my-serial-baud
		      "\nSLIP MTU: " my-slip-mtu
		      "\nSLIP options: " my-slip-options
		      "\n\nIs this correct?")
		     (help
		      "    Check the information shown. If you do not "
		      "confirm it, all of it will be asked again.")))
	       1			; ask it all again
	     (
	      ;; store the file name and the configuration string
	      (set if-config-file my-host-if)
	      (if (= my-host-if "rhcslip0") ;; special case
		  (set if-config-file "rhslip0"))
	      (set if-config-file
		   (cat if-config-file ".config"))
	      (set if-config
		   (cat my-serial-device " "
			my-serial-unit " "
			my-serial-baud " "
			"0.0.0.0 "
			"MTU=" my-slip-mtu " "
			my-slip-options))
	      0				; no need to ask again
	      ))))
      )
   )
 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-ggbus-config
 ;;
 ;; the my-host-if has to be set before this is called
 ;;
 ;; this sets the if-config-file on return ("" if not applicaple)
 ;; the contents is stored in if-config
 ;;
 (transcript "Creating configuration file for GGBus+ devices.")
 ;;
 ;; Common help
 ;;
 (set isa-help (cat "    Refer to the ISA board and GGBus+ manuals for more "
		    "information."))

 ;;
 ;; Loop until the user is satisfied
 ;;
 (while
     ((set my-isa-irq
	   (asknumber
	    (prompt "\nGive the ISA IRQ number for the " my-host-if ":")
	    (default 3)
	    (if (= my-host-if "gg_smc")
		(range 3 5)
	      (range 1 15)
	      )
	    (help "    Give the ISA IRQ number for the interface "
		  my-host-if " to use. The given number must match "
		  "with the setting on the board.\n" isa-help))
	   my-isa-ioaddr
	   (askstring
	    (prompt "\nGive the ISA I/O-address of the " my-host-if ".\n"
		    "\nThe address must be entered in hex, starting with "
		    "\"0x\".\n")
	    (default "0x300")
	    (help "    The given I/O-address must match with the setting "
		  "on the board.\n" isa-help))
	   my-isa-memaddr
	   (if (= my-host-if "gg_smc")
	       (askstring
		(prompt "\nGive the ISA memory base address for the "
			my-host-if ".\n" 
			"\nThe address must be entered in hex, starting with "
			"\"0x\".\n")
		(default "0xd0000")
		(help "    The given base address must match with the setting "
		      "on the board.\n" isa-help))))
	   
      (if (not (askbool
		(prompt
		 "This is the information you gave for the configuration "
		 "for the " my-host-if ":\n"
		 "\nISA IRQ number: " my-isa-irq
		 "\nISA I/O-address: " my-isa-ioaddr
		 (if my-isa-memaddr
		     (cat "\nISA memory base address: " my-isa-memaddr))
		 "\n\nIs this correct?")
		(help
		 "    Check the information shown. If you do not "
		 "confirm it, all of it will be asked again.")))
	  1			; ask it all again
	(
	 ;; store the file name and the configuration string
	 (set if-config-file (cat my-host-if ".config_0"))
	 (set if-config
	      (cat "IRQ=" my-isa-irq " "
		   "IOADDR=" my-isa-ioaddr " "
		   (if my-isa-memaddr
		       (cat "MEMADDR=" my-isa-memaddr " "))
		   ))
	 0				; no need to ask again
	 )))
   )
 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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...")
 (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 "Should this Sana-II driver be installed in Devs:Networks?\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.")
	     (source (pathonly dist-name))
	     (choices (fileonly dist-name))
	     (dest "DEVS:Networks")
	     (files)
	     (optional "nofail" "askuser")
	     (confirm "average"))))))

 ;;; ask user which export/Env/Sana2 files should be copied
 (if (= 2 (exists (tackon source-dir "export/Env/Sana2")))
     (if
	 (askbool (prompt "\nDo 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 "export/Env/Sana2"))
	  (dest "ENVARC:sana2")
	  (all)
	  (files)
	  (optional "nofail" "askuser")
	  (confirm "average")))
   ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-update-devices
 (if (= 2 (exists dist-networks-dir))
     (if (askbool
	  (prompt "\nDo you want to update your Sana-II network device "
		  "drivers?\n"
		  "Each copy will be confirmed.")
	      (help
	       "    Each new AmiTCP/IP distribution usually contains "
	       "updated versions of some of the provided Sana-II network "
	       "device drivers. If you choose \"Yes\", this installation "
	       "script will check for each device, if this is the case."))
	     (update-devices)
       (transcript "User did not want to update Sana-II drivers."))
   (transcript "Directory " dist-networks-dir " not found.")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-if-dynamic ;; Ask if the network connection is dynamic
 (set is-if-dynamic
      (askbool (prompt "\nIs your network connection dynamic?")
	       (help "    If your network connection is dynamic, your IP "
		     "address will change each time you connect to the "
		     "network. Because of this you can not have a "
		     "fixed host name either. If this is the case, "
		     "you will not be asked for the host name.\n"
		     "    If your network connection is not "
		     "dynamic, then you should have a fixed IP address.\n"
		     "    The \"startnet\" script produced by this "
		     "installation script will have an optional IP "
		     "address argument, which you should use if your "
		     "network connection is dynamic.\n")
	       (default 0)))
 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-hostname ;; Get host name, domain and aliases
 ;;
 ;; Get the hostname from environment variable
 ;;
 (set def-full-name (if (exists "ENV:HOSTNAME")
			(getenv "HOSTNAME")
		      "")
      my-host-name ""
      my-host-aliases ""
      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))))
 ;;
 ;; If the network connection is dynamic, do not ask the host name, but leave
 ;; it empty.
 ;;
 (if (not is-if-dynamic)
     ;;
     ;; 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 "\nEnter 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, "
		   "\"nsdi.fi\" is the domain name of the Network "
		   "Solutions Development Inc., Finland.\n")
	     (default def-host-name))))
   )
 ;;
 ;; ask the domain name from the user
 ;;
 (set my-domain-name
      (askstring
       (prompt (if is-if-dynamic 
		   "\nEnter your domain name:"
		 "\nEnter 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, "
	     "\"nsdi.fi\" is the domain name of the Network "
	     "Solutions Development Inc., Finland.\n"
	     "    If you do not have a domain name server, then you might "
	     " not have a domain, either. In this case you can leave the "
	     "domain empty.\n")
       (default def-domain-name)))
 ;;
 ;; Set the full name of this host. 
 ;;
 (set my-full-name (if my-host-name
		       (cat my-host-name
			    (if my-domain-name
				(cat "." my-domain-name)
			      ""))))
 ;;
 ;; ask alias names for this host if the host name is not empty
 ;;
 (if 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 "")
	       (help net-setup-help
		     "    Your computer may have additional names "
		     "(aliases) to its official name.\n"
		     "    The plain host name (" my-host-name ") will "
		     "be understood by the " app-name " automatically, so "
		     "you do not need to include that as an alias. "
		     )))
       (set my-host-aliases (cat my-host-aliases " " new-host-name))))
 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Ask network interfaces
;;;
;;; Loop until no device is given.
;;;
(procedure
 ask-interfaces

 (set number-of-interfaces 0)

 ;;
 ;; Procedure to ask the network device driver name
 ;;
 ;; (Returns TRUE if an interface was selected)
 ;;
 ;; NOTE: Currently only 8 choises within each interface type are allowed
 ;;       (excluding the "none" entry).
 ;; 
 (procedure
  if-ask-device
  (set my-host-if-type
       ((set choice
	     (askchoice
	      (prompt (cat "Select "
			   (if (= number-of-interfaces 0)
			       "the"
			     "another")
			   " network interface type to be used:")
		      (help "    You should select your network interface "
			    "type from the given choices. If your device type "
			    "is "
			    "not listed select some other (which matches "
			    "closest to your device) and alter "
			    "the installation (and db/interfaces file) "
			    "by hand.\n"
			    "    Select \"None\" if you do not want to "
			    "configure "
			    (if (= number-of-interfaces 0)
				"an"
			      "another")
			    " interface.")
		      (choices "None"			; 0
			       "SLIP/CSLIP"		; 1
			       "PPP"			; 2
			       "X.25"			; 3
			       "Ethernet"		; 4
			       "Arcnet"			; 5
			       "GGBus+ Ethernet"	; 6
;; Not yet			       "Village Tronic Liana"   ; 7
			       )
		      (default 0))))
	;;;
	;;; Destination IP address is asked for p-to-p interfaces only
	;;; also, the destination IP address suffices as the default 
	;;; gateway address in most cases.
	;;;
	(set my-host-if-point-to-point (select choice
					       0	; None
					       1	; slip/cslip
					       1	; ppp
					       0	; x.25
					       0	; ethernet
					       0	; arcnet
					       0	; GGBus+ Ethernet
					       0	; VT Liana
					       ))
	choice)
       
       my-host-if
       (if (= my-host-if-type 0)
	   ""
	 ((set choice
	       (askchoice
		(prompt (cat "Select "
			     (if (= number-of-interfaces 0)
				 "the"
			       "another")
			     " network interface to be used:"))
		(help "    You should select your network interface "
		      "from the given choices. If your device is "
		      "not listed select some other (which matches "
		      "closest to your device) and alter "
		      "the installation (and db/interfaces file) "
		      "by hand.\n"
		      "    Select \"None\" if you do not want to "
		      "configure "
		      (if (= number-of-interfaces 0)
			  "an"
			"another")
		      " interface.")
		(select (- my-host-if-type 1)
			(			; type 1 (SLIP/CSLIP)
			 (choices "None"	; 0
				  "rhslip"	; 1
				  "rhcslip"	; 2
				  )
			 (default 1))
			(			; type 2 (PPP)
			 (choices "None"	; 0
				  "ppp"		; 1
				  )
			 (default 1))
			(			; type 3 (AX.25)
			 (choices "None"	; 0
				  "axdm"	; 1
				  )
			 (default 1))
			(			; type 4 (Ethernet)
			 (choices "None"	; 0
				  "CBM A2065"	; 1
				  "Hydra Ethernet" ; 2
				  "Golden Gate wd80xx (trossi)" ; 3
				  "ASDG EB920"	; 4
				  "Village Tronic Ariadne" ; 5
				  )
			 (default 1))
			(			; type 5 (Arcnet)
			 (choices "None"	; 0
				  "CBM A2060"	; 1
				  )
			 (default 1))
			(			; type 6 (GGBus+ Ethernet)
			 (choices "None"	; 0
				  "3COM 3C503"	; 1
				  "NE1000" 	; 2
				  "NE2000" 	; 3
				  "WD80x3"	; 4
				  )
			 (default 3))
			(			; type 7 (Liana)
			 (choices "None"	; 0
				  "Liana unit 0" ; 1
				  "Liana unit 1" ; 2
				  )
			 (default 1))
			)
		))
	  (if (= choice 0)
	      ""
	    ;;;
	    ;;; Following names must match the ones defined in db/interfaces
	    ;;;
	    (select (+ (* (- my-host-if-type 1) 8) (- choice 1))
					; type 1 (SLIP/CSLIP)
		    "slip0"	; (1) 
		    "cslip0"	; (2)
		    ""		; (3)
		    ""		; (4)
		    ""		; (5)
		    ""		; (6)
		    ""		; (7)
		    ""		; (8)
					; type 2 (PPP)
		    "ppp0"	; (1) 
		    ""		; (2)
		    ""		; (3)
		    ""		; (4)
		    ""		; (5)
		    ""		; (6)
		    ""		; (7)
		    ""		; (8)
					; type 3 (AX.25)
		    "ax25"	; (1) 
		    ""		; (2)
		    ""		; (3)
		    ""		; (4)
		    ""		; (5)
		    ""		; (6)
		    ""		; (7)
		    ""		; (8)
					; type 4 (Ethernet)
		    "a2065"	; (1) 
		    "hydra"	; (2)
		    "wd80xx"	; (3)
		    "eb920"	; (4)
		    "ariadne"	; (5)
		    ""		; (6)
		    ""		; (7)
		    ""		; (8)
					; type 5 (Arcnet)
		    "a2060"	; (1) 
		    ""		; (2)
		    ""		; (3)
		    ""		; (4)
		    ""		; (5)
		    ""		; (6)
		    ""		; (7)
		    ""		; (8)
					; type 6 (GGBus+ Ethernet)
		    "gg_3c503"	; (1) 
		    "gg_ne1000"	; (2)
		    "gg_ne2000"	; (3)
		    "gg_smc"	; (4)
		    ""		; (5)
		    ""		; (6)
		    ""		; (7)
		    ""		; (8)
					; type 7 (Village Tronic Liana)
		    "liana0"	; (1) 
		    "liana1"	; (2)
		    ""		; (3)
		    ""		; (4)
		    ""		; (5)
		    ""		; (6)
		    ""		; (7)
		    ""		; (8)
		    ))))))

 ;;
 ;; Ask for the unit number
 ;;
 ;; NOTE: Currently not used
 ;;
 (procedure
  if-ask-unit
  (set my-host-if-unit
       (asknumber
	(prompt "\nSelect unit number for the " my-host-if ":")
	(default 0)
	(help "    Select the unit number for the interface "
	      my-host-if " to use. This is usually 0 for the first "
	      "unit of that particular network interface. "
	      "The network interface unit numbers are normally directly "
	      "mapped to the Sana-II device driver unit numbers. "
	      "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
			(if is-if-dynamic
			    (cat 
			     "Your IP address is dynamic, but you still "
			     "should give a default "))
			"IP address for the interface " my-host-if ".\n"
			(if is-if-dynamic
			    (cat 
			     "When you start the " app-name " "
			     "with \"startnet\", "
			     "You should give the correct IP address as an "
			     "argument to override the default.")))
       ::ask-ip-help (cat "    If you have no connection to the global "
			  "Internet and are configuring a private network, "
			  "you can select your IP addresses from following "
			  "ranges: (see RFC1597)\n\n"
			  "10.0.0.0 - 10.255.255.255\n"
			  "172.16.0.0 - 172.31.255.255\n"
			  "192.168.0.0 - 192.168.255.255\n\n"
			  "NOTE: The addresses at the end of the ranges are "
			  "NOT usable IP addresses for a host! So select your "
			  "address from INSIDE the range (for example: "
			  "10.1.1.1).")
       ::ask-ip-need 1
       ::ask-ip-default ""
       my-host-addr (ask-ip-address)))

 ;;
 ;; Ask for the destination address for the point-to-point interfaces
 ;;
 (procedure
  if-ask-dest-address
  (set dest-host
       (if my-host-if-point-to-point
	   ((set ::ask-ip-prompt 
		 (cat "Give the destination address for the "
		      "point-to-point interface " my-host-if ".\n"
		      "Address of interface is " my-host-addr ".\n"
		      "\n"
		      "Normally this is the same as the default gateway "
		      "address.\n"
		      )
		 ::ask-ip-help 
		 (cat "    A point-to-point interface is one that is "
		      "connected to a medium which only two hosts can "
		      "attach, for example the normal serial line: "
		      "your computer is in other end and the other "
		      "computer is on the other end.\n"
		      "    The destination address of an point-to-point "
		      "interface is the IP address of the host (or "
		      "terminal server) at the other end of the link.\n"
		      "    If the destination address is not known for "
		      "some reason, and you are going to configure only "
		      "one interface, you can use the default gateway "
		      "address as your p-to-p destination address.")
		 ::ask-ip-need 1
		 ::ask-ip-default ""
		 )
	    (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 my-host-netmask
       ((set ::ask-ip-prompt
	     (cat "Give netmask of the network on the interface " my-host-if
		  ".\n"
		  "Address of the 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's IP address "
		  "are used to identify the network (the network address).\n"
		  "    For example, \"255.255.255.0\" "
		  "is a possible netmask.\n"
		  "    The netmask must be the same for all the interfaces "
		  "connected to the same network.\n"
		  "    If you do NOT know the netmask, then leave "
		  "it empty, a default value will be computed from "
		  "your interface's IP address. This is correct only if "
		  "the network is not divided into subnets.")
	     ::ask-ip-need 0
	     ::ask-ip-default ""
	     )
	(ask-ip-address))))

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

 ;;
 ;; Ask if user wants to install another interface
 ;;
 (procedure
  if-ask-another
  (askbool
   (prompt "Do you want to install another interface?")
   (help "    You have already configured " number-of-interfaces 
	 " interfaces. Select \"Yes\" if you want to configure yet "
	 "another interface.")))

 ;;
 ;; Set startup string to contain configuration for the loopback device
 ;; (Other information will be later appeneded to this string variable).
 ;;
 (set 
      ;; a complete list for IP address to host name mappings..
      ;; (only one mapping for now)
      address-mapping "")
 ;;
 ;; Ask for interfaces
 ;;
 (while
     (if ((if-ask-device)
	 ((if-ask-address)
	  (if-ask-dest-address)
	  (if-ask-netmask)
	  (if (if-confirmation)
	      ((transcript "Adding interface " my-host-if)
	       ;;
	       ;; Ask interface configuration. First the 'if-config-file'
	       ;; is cleared. Following calls change it if necessary. Later
	       ;; the config file is created if this variable is non-nil
	       ;;
	       (set if-config-file "")
	       (if (= my-host-if-type 1)
		   (ask-slip-config))
	       (if (= my-host-if-type 6)
		   (ask-ggbus-config))
	       (set
		number-of-interfaces (+ number-of-interfaces 1)
		)
	       0) ;; (if-ask-another) only one interface for now
	    1) ;;; confirmation not given, ask again
	  ))))
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-gateway ;;; Ask the default gateway address
 ;;
 (set ::ask-ip-prompt (cat
		       "Enter the IP address of the default gateway"
		       (if (AND (= number-of-interfaces 1)
				my-host-if-point-to-point)
			   (cat 
			    ". Since you have configured only one interface, "
			    "and that interface is of point-to-point type, "
			    "the destination address of the interface is "
			    "offered as default value. Generally you can "
			    "accept this default.")
			 ":")
		       )
      ::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
      ::ask-ip-default (if (AND (= number-of-interfaces 1)
				my-host-if-point-to-point)
			   dest-host
			 "")
      def-gateway-addr (ask-ip-address))
 ;;
 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; resolv.conf configuration
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(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
	  ::ask-ip-default ""
	  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
 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
 create-config-file
 ;;
 (textfile (dest (tackon conf-dir "resolv.conf"))
	   (append
	    (if name-server-list (cat "; Name servers\n" name-server-list)))
	   (append
	    (if domain-list (cat "; Domain names\n" domain-list)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 create-startup-script
 ;;
 ;; Create the network startup-script (AmiTCP:bin/startnet)
 ;;
 (textfile (dest (tackon bin-dir "startnet"))
	   (append
	    (cat
					;;; Script header
	     ".key IPADDRESS\n"
	     ".bra {\n"
	     ".ket }\n"
	     ".def IPADDRESS " my-host-addr "\n"
	     "\n"
					;;; Log in
	     "; log in\n"
	     "echo\n"
	     "echo login: " default-user-name "\n"
	     (tackon bin-dir "login") " -f " default-user-name "\n"
	     (tackon bin-dir "umask") " 022\n"
					;;; Start AmiTCP
	     "AmiTCP:AmiTCP\n"
	     "WaitForPort AMITCP\n"
					;;; Configure lo0
	     "; Configure loop-back device\n"
	     (tackon bin-dir "ifconfig") " lo0 localhost\n"
					;;; Create interface config file
	     (if if-config-file
		 (cat
		  "; Assure that ENV:Sana2 exists\n"
		  "if not exists ENV:Sana2\n"
		  "  makedir ENV:Sana2\n"
		  "endif\n"
		  "; Create " my-host-if " configuration file\n"
		  "echo \"" if-config "\" >ENV:Sana2/" if-config-file "\n"))
					;;; Configure the network interface
	     "; Configure " my-host-if "\n"
	     (tackon bin-dir "ifconfig") " " my-host-if " {IPADDRESS}"
	     (if dest-host
		 (cat " " dest-host))
	     (if my-host-netmask
		 (cat " netmask " my-host-netmask))
	     "\n"
					;;; Add the host name to the netdb
	     (if my-host-name
		 (cat
		  "; Add IP address entry for this host \n"
		  "rx \"address AMITCP; 'ADD HOST {IPADDRESS} "
		  my-full-name " " my-host-aliases "'\""
		  "\n"))
					;;; Route for this host
	     "; Add route to this host\n"
	     (tackon bin-dir "route") " add {IPADDRESS} localhost\n"
					;;; Route for the default gateway
	     (if def-gateway-addr
		 (cat 
		  "; Add route to the default gateway\n"
		  (tackon bin-dir "route") " add default " def-gateway-addr
		  "\n"))
					;;; Set the ENV:HOSTNAME
	     "setenv HOSTNAME `AmiTCP:bin/hostname`\n"
					;;; Mount TCP: (inet-handler)
	     tcp-mount
					;;; Start inetd?
	     (if (askbool
		  (prompt "\nDo 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"
			"    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 started-at-boot 0
      to-be-added-to-startup
      (cat "assign " atcp-assign " " @default-dest "\n"
	   "path " bin-dir " add\n"
	   apipe-mount
	   (if (not is-if-dynamic)
	       (if (askbool
		    (prompt
		     "\nDo you want the " @app-name
		     " to be started at the system startup?")
		    (help
		     "    If you decide not to start the " @app-name " at "
		     "startup, you can later start it by giving command "
		     "\"startnet\" "
		     "at the command shell."))
		   ((set started-at-boot 1)
		    (tackon bin-dir "startnet\n"))))
	   (if (AND
		(= 2 (exists include-dir))
		(= 2 (exists lib-dir)))
	       (if (askbool
		    (prompt "\nDo 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 "\nDo 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 the " @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
 ask-copy-old-configuration
 ;;
 ;; Copy old configuration files
 ;; Returns TRUE if AmiTCP does not need to be configured.
 ;; The reconfiguration is forced if old AmiTCP version is not 4 or higher,
 ;; since the bin/startnet must be modified.
 ;;
 (set
  edit-change-fingerd "t:edit-change-fingerd"
  old-conf-dir (tackon old-atcp-directory "db")
  old-resolv.conf (tackon old-conf-dir "resolv.conf")
  old-startnet (tackon old-atcp-directory "bin/startnet")
  old-motd (tackon old-conf-dir "motd"))
 ;;
 ;; return version of the old AmiTCP detected
 ;;
 (procedure 
  get-old-atcp-version
  (if (exists (tackon old-atcp-directory "AmiTCP") (noreq))
      (/ (getversion (tackon old-atcp-directory "AmiTCP")) 65536)
    0))
 ;;
 (set old-atcp-version (get-old-atcp-version))
 ;;
 ;; following is called only if old version is high enough
 ;;
 (procedure 
  copy-myhost-config 
  (if (AND (exists old-resolv.conf)
	   (exists old-startnet))
      ((if (>= @user-level 2)
	   (message "\nCopying files\n\n"
		    old-resolv.conf "\n"
		    old-startnet "   \n"
		    "\nto directory \"" @default-dest "\"."))
       (copyfiles
	(source old-resolv.conf)
	(dest conf-dir)
	(files))
       (copyfiles
	(source old-startnet)
	(dest bin-dir)
	(files))
       1				; succeeded
       )))
 ;;
 (procedure 
  copy-rest-config
  (copyfiles
   (prompt
    "Select configuration files you want to copy from old configuration")
   (help
    "    You may copy your old configuration files or use untouched files "
    "came with the new distribution.")
   (source old-conf-dir) 
   (dest conf-dir)
   (files)
   (confirm)
   (if (AND (exists (tackon old-conf-dir "networks"))
	    (AND (exists (tackon old-conf-dir "ftpdir"))
		 (exists (tackon old-conf-dir "ftpusers"))))
       (choices				; release 4.0 or later
	"AmiTCP.config"
	"ch_nfstab"
	"ftpdir"
	"ftpusers"
	"group"
	"inet.access"
	"inetd.conf"
	"interfaces"
	"hosts"
	"networks"
	"services"
	"protocols"
	"passwd"
	"rpc")
     (if (exists (tackon old-conf-dir "inet.access"))
	 (choices			; release 3.0 beta 2 or later
	  "AmiTCP.config"
	  "ch_nfstab"
	  "group"
	  "inet.access"
	  "inetd.conf"
	  "hosts"
	  "services"
	  "protocols"
	  "passwd"
	  "rpc")
       (if (exists (tackon old-conf-dir "interfaces"))
	   (choices			; release 3.0 beta 1 or later
	    "AmiTCP.config"
	    "group"
	    "inetd.conf"
	    "hosts"
	    "services"
	    "protocols"
	    "passwd"
	    "rpc")
	 (if (exists (tackon old-conf-dir "passwd"))
	     (choices			; release 2.2 or later
	      "AmiTCP.config"
	      "group"
	      "inetd.conf"
	      "hosts"
	      "services"
	      "protocols"
	      "passwd")
	   (choices			; an old release
	    "AmiTCP.config"
	    "inetd.conf"
	    "hosts"
	    "services"
	    "protocols")))))
   (optional "nofail" "force" "askuser")))
 ;;
 (procedure 
  copy-motd
  (if (exists old-motd)
      ((if (>= @user-level 2)
	   (message "\nCopying file\n\n"
		    old-motd "\n"
		    "(Message Of The Day)\n"
		    "\nto directory \"" conf-dir "\"."))
       (copyfiles
	(source old-motd)
	(dest conf-dir)
	(files)))))
 ;;
 ;; Following is currently not needed, since if old version is too old, we
 ;; force user to reconfigure AmiTCP anyway
 ;;
 (procedure 
  update-startnet
  (set startnet-file (tackon bin-dir "startnet"))
  (if (run (cat "search search \"Mount TCP:\" quiet from " startnet-file)
	   (safe))
      ((textfile (dest startnet-file)
		 (include startnet-file)
		(append tcp-mount "\n")
		(prompt 
		 "\nDo you want to mount TCP: device at network startup?")
		(help 
		 "    The " @app-name " includes a DOS handler for TCP "
		 "communications. This DOS handler will usually be mounted "
		 "at the network startup.")
		(confirm))
       (protect (tackon bin-dir "startnet") "+s +e"))))
 (procedure
  update-services
  (set service-file (tackon conf-dir "services"))
  (if (run (cat "search search \"amiganetfs\" quiet from " service-file)
	   (safe))
      (;; Not found, add it 
       (textfile (dest service-file)
		 (include service-file)
		 (append ";\n; Amiga specific services\n;\n"
			 "amiganetfs      2500/tcp\n")
		 (prompt 
		  "Do you want to add AmigaNetFS service to your "
		  "service database?")
		 (help 
		  "    The " @app-name " includes NetFS, network file system "
		  "between Amigas, by Timo Rossi. It is a TCP based protocol "
		  "which requires both ends of connection have same service "
		  "(TCP port) entries. If you already had NetFS installed "
		  "you probably do not want to update your service "
		  "database.")
		 (confirm)))))
 (procedure
  update-hosts
  (set hosts-file (tackon conf-dir "hosts"))
  (if (run (cat "search search \"localhost\" quiet from " hosts-file)
	   (safe))
      (;; Not found, add it
       (transcript "Adding 'localhost' entry to the db/hosts.")
       (textfile (dest hosts-file)
		 (include hosts-file)
		 (append ";\n; Entry for the localhost\n;\n"
			 "127.0.0.1 localhost\n")
		 ))))
 (procedure
  update-inetd-conf
  ;; Change fingerd to serv/in.fingerd
  (set inetd-conf (tackon atcp-assign "db/inetd.conf"))
  (if (run (cat "search search \"serv/in.fingerd\" quiet from " inetd-conf)
	   (safe))
      ((textfile 
	(dest edit-change-fingerd)
	(append
	 "f b/finger    stream/\n"
	 "e -amitcp:bin/fingerd-amitcp:serv/in.fingerd-\n"
	 "m+"
	 "i"
	 "# NetFS, a networking support between Amigas"
	 "# Remove # from the next line to enable NetFS"
	 "#amiganetfs stream    tcp nowait root amitcp:serv/netfs-server"
	 "Z"
	 "w\n")
	(safe))
       (run (cat "c:edit from " inetd-conf " with "
		 edit-change-fingerd " >t:what-changed")
	    (confirm)
	    (prompt "\nUpdate \"inetd.conf\" to use the " @app-name " services?")
	    (help "    The fingerd service daemon is moved to directory "
		  "\"AmiTCP:serv\", and \"inetd.conf\" must be updated to use "
		  "it. Also the NetFS must be added to old configuration")))))
 ;;
 (procedure 
  update-napsaprefs
  (set old-napsaprefs
       (if (exists (tackon old-atcp-directory "db/NapsaPrefs") (noreq))
	   (tackon old-atcp-directory "db/NapsaPrefs")
	 (if (exists "s:NapsaPrefs")
	     "s:NapsaPrefs")
	 ""))
  (if old-napsaprefs
      (;;
       (copyfiles 
	(source old-napsaprefs)
	(dest conf-dir)
	(files)
	(confirm)
	(prompt "\nUse your old Napsaterm preferences?")
	(help  "    Installer have found an existing NapsaPrefs file "
	       old-napsaprefs ". You can copy it to new configuration "
	       "directory.")))))
 (procedure 
  copy-extra-binaries
  "")
 (transcript "Ready to copy old configuration.")
 (if (askbool
      (default 1)
      (prompt
       "\nDo you want to use settings from an earlier installation?")
      (help
       "    Installer have detected existing configuration "
       "directory \"" old-conf-dir "\" which "
       "can be used to configure the " app-name ". You can keep most "
       "of your previous configuration. This is important if you have "
       "installed extra applications.\n"
       (if (< old-atcp-version 4)
	   (cat "    However, since the configuration practice of the "
		@app-name " has changed since your old version, you must "
		"reconfigure the " @app-name " itself. Sorry for the "
		"incovenience.\n")
	 (cat "    Installer will copy your \"" old-startnet "\" script and "
	      "\"" old-resolv.conf "\" configuration.\n"))
       "    Other configuration files will be then "
       (if (> @user-level 1) 
	   "optionally")
       " copied.\n"))
     ((set no-reconfig (if (>= old-atcp-version 4)
			   (copy-myhost-config)))
      (copy-rest-config)
      (copy-motd)
      (update-inetd-conf)
      (update-hosts)
      (update-services)
;;      (update-startnet)
      (update-napsaprefs)
      (copy-extra-binaries)
      no-reconfig) ;; FALSE if AmiTCP needs to be reconfigured
   0))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 install-emacstcp
 ;; is GNU Emacs installed?
 (if (exists "GNUEmacs:" (noreq)) ; check if GNUEmacs is installed
     (if (exists (tackon source-dir "export/GNUEmacs"))
	 ((transcript "Installing GNUEmacs support files.")
	  (copyfiles
	   (source (tackon source-dir "export/GNUEmacs/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 "#?.el#?")
	   (dest "GNUEmacs:lisp")
	   (optional "nofail" "askuser")
	   (confirm))
	  (copyfiles
	   (source (tackon source-dir "export/GNUEmacs/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 (cat "run " pager-cmd)
	       (tackon source-dir "export/GNUEmacs/add_to_.emacs")
	       (safe)))
       (message "GNUEmacs not present in " source-dir "."))
   (message "GNU Emacs must be installed before....")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ask-install-emacstcp
 ;; is GNU Emacs installed?
 (if (exists "GNUEmacs:" (noreq)) ; check if GNUEmacs is installed
     (if (exists (tackon source-dir "export/GNUEmacs"))
	 (if (askbool
	      (prompt "\nDo 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 "GNUEmacs not present on " source-dir "."))
   (transcript "No GNU Emacs detected in system.")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 install-napsaterm
 ;;
 ;; Install Napsaterm fonts
 ;;
 ;; Ask for directory to install fonts.
 (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 the assign fonts:).")
   (newpath)
   (default "fonts:")))
 (if (exists (tackon source-dir "export/Fonts"))
     (copyfiles
      (source (tackon source-dir "export/Fonts"))
      (prompt "Copying font `napsa' to " napsa-font-dir ".")
      (dest (ask-napsa-font-dir))
      (optional "nofail")
      (fonts)
      (all))
   (transcript "export/Fonts not present on " source-dir ".")))

(procedure
 ask-install-napsaterm
 ;; Optionally install Napsafonts
 (if (exists (tackon source-dir "export/Fonts"))
     (if (askbool
	  (prompt "Do you want to install Napsaterm fonts, napsa?\n"
		  "\n    (Napsaterm uses the special fonts in its window "
		  "if they are installed. "
		  "They are sized 611 pixels and contain some special VT102 "
		  "characters. They are suitable for interlaced screens. "
		  "If you have normal NTSC or PAL screen, it might be better "
		  "to not install Napsa and use Topaz/8.)\n")
	  (help
	   "    Napsaterm is a VT102 terminal emulator which uses the rlogin "
	   "and telnet protocols. 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 "export/Fonts not present on " source-dir ".")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ;;
 ;; Check if user exists in the user database
 ;;
 ;; takes the user name in ::user-name
 ;;
 does-user-exist
 (if (run (cat "search " (tackon conf-dir "passwd") " \"" ::user-name "|\" NONUM ")
	  (safe))
     0
   1)
 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure 
 ;;
 ;; Add a new user into AmiTCP:db/passwd
 ;;
 add-new-user
 (if (= anu::setdefaults 0)
     (set   
      anu::passwd (tackon conf-dir "passwd")
      anu::passwd-new (cat anu::passwd ".new")
      anu::passwd-old (cat anu::passwd ".old")
      anu::tempfile "t:run-the-password"
      anu::helptext (cat "    You must give an login name, user ID, group ID"
			 "real name and home directory for each user.\n")
      anu::setdefaults 1
      anu::username (cat default-user-name)
      anu::UID 100
      anu::GID 100
      anu::realname ""
      anu::homedir "HOME:"
      anu::shell "shell"))
 (while
     ((set anu::username
	   (askstring
	    (default anu::username)
	    (prompt "Enter the login name of the new user:\n")
	    (help anu::helptext
		  "    The login name consists of lowercase letters a-z "
		  "and numbers.  Its recommended maximum length is 8 "
		  "characters.\n"
		  "    Examples of acceptable login names are `ppessi' "
		  "and `an345'.")))
      (set ::user-name anu::username)
      (if (does-user-exist)
	  ((message "User " anu::username " already exists.")
	   1))))
 (set anu::UID
      (asknumber
       (default anu::UID)
       (prompt (cat "Enter the user ID of the user " anu::username ":\n"))
       (help anu::helptext
	     "    The user ID is a numeric unique identifier for each "
	     "user. "
	     "It is a number between 100 - 32767 for ordinary users.\n")))
 (set anu::GID
      (asknumber
       (default anu::GID)
       (prompt (cat "Enter the primary group ID of the user " 
		    anu::username ":\n"))
       (help anu::helptext
	     "    The group ID is a numeric identifier of groups. "
	     "Each user has a primary group, which is usually 100, "
	     "group \"users\".\n")))
 (set anu::realname
      (askstring
       (default anu::realname)
       (prompt (cat "Enter the real name of the user " anu::username ":\n"))
       (help anu::helptext
	     "    The real name can contain any characters except "
	     "comma (`,'), colon (`:') or bar (`|').")))
 (set anu::homedir
      (askdir
       (default anu::homedir)
       (prompt (cat "Give the home directory of the user " anu::username ":\n"))
       (help anu::helptext
	     "    When user logs in, the current directory is changed to"
	     "her home directory.  Also, the finger information (.plan"
	     "and .project) is retrieved from home directory.")
       (newpath)))
 (set anu::shell
      (askstring
       (default anu::shell)
       (prompt (cat "Enter the name of command interpreter for the user "
		    anu::username ":\n"))
       (help anu::helptext
	     "    The command interpreter value can be either "
	     "`shell' or `cli'.")))
 (set anu::passwd-entry 
      (cat anu::username "||" anu::UID "|" anu::GID "|" 
	   anu::realname "|" anu::homedir "|" anu::shell "\n"))
 (if (askbool 
      (prompt (cat "Are you sure you want to add following user:\n\n"
		   "Login name: " anu::username "\n"
		   "User ID: " anu::UID "\n"
		   "Group ID: " anu::GID "\n"
		   "Real name: " anu::realname "\n"
		   "Home directory: " anu::homedir "\n"
		   "Shell: " anu::shell "\n"))
      (choices (cat "Add " anu::username) (cat "Skip " anu::username))
      (help "You can still skip creating the new user."))
     ((textfile (dest anu::passwd-new)
		(include anu::passwd)
		(append anu::passwd-entry))
      (copyfiles (source anu::passwd)
		 (dest conf-dir)
		 (newname "passwd.old")
		 (optional "askuser"))
      (copyfiles (source anu::passwd-new)
		 (dest conf-dir)
		 (newname "passwd")
		 (optional "askuser"))
      (textfile (dest anu::tempfile)
		(append (cat 
			 "failat 5000\n"
			 (tackon bin-dir "login") " " anu::username "\n"
			 (tackon bin-dir "passwd") " " anu::username "\n"
			 "endshell\n"))
		(safe))
      (run (cat "newshell from " anu::tempfile))
      (set anu::username ""
	   anu::UID (+ anu::UID 1)
	   anu::realname "")
      1))
 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ;;
 ;; Add a new users into AmiTCP:db/passwd
 ;;
 add-new-users
 (while
     (askbool (prompt "\nDo you want to create a new user account?\n"
		      "\nYou will be logged in with the new account "
		      "immediately to set the password.")
	      (choices "Proceed" "Cancel")
	      (help "    You are about to add a new users into user database. "
		    "Remember that the user id of each user must be unique! "
		    "You will be logged in with the new user account to "
		    "set the password for the new user.\n"))
   (add-new-user))
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure 
 ;;
 ;; Ask for the default user
 ;;
 ask-default-user
 (if (= adu::setdefaults 0)
     (set   
      adu::setdefaults 1
      default-user-name ""))
 (while (= default-user-name "")
   (while
       ((set default-user-name
	     (askstring
	      (default default-user-name)
	      (prompt "Enter the default user name\n")
	      (help "    The AmiTCP/IP can handle currently only one user "
		    "at a time.  The default user is selected with `login' "
		    "command by system startup script. ")))
	(set ::user-name default-user-name)
	(if (NOT (does-user-exist))
	  (NOT (add-new-user))))))
 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(procedure
 ;;
 ;; Install passwd and group databases
 ;;
 install-user-databases
 (transcript "Installing user databases")
 (procedure get-mufs-version
	    (set mufs-vernum (getversion "multiuser.library" (resident)))
	    (set mufs-ver (/ mufs-vernum 65536))
	    (set mufs-rev (- mufs-vernum (* ver 65536))))
 (procedure passwd-create
	    (copyfiles
	     (prompt "Copying " passwd-source " to AmiTCP:db/passwd.")
	     (source passwd-source)
	     (dest conf-dir)
	     (newname "passwd")
	     (optional "nofail")))
 (procedure group-create
	    (copyfiles
	     (prompt "Copying " group-source " to AmiTCP:db/group.")
	     (source group-source)
	     (dest conf-dir)
	     (newname "group")
	     (optional "nofail")))
;
; THESE ARE NOT USED AT THE MOMENT
;
; (procedure 
;  ;;
;  ;; Change root's password 
;  ;;
;  change-root-password
;  (set iud::script "t:change-root-file")
;  (textfile (dest iud::script)
;	    (append 
;	     "failat 5000\n"
;	     "echo Log in as super-user (root):\n"
;	     (tackon bin-dir "login") " root\n"
;	     "echo Change the password of root:\n"
;	     (tackon bin-dir "passwd") "\n"
;	     "endcli")
;	    (safe))
;  (message "Logging in as `root' and changing the root's password.")
;  (run (cat "newshell from " iud::script)
;       (safe)))
; ;; If we are running multiuser 1.4, do some special
; (get-mufs-version)
; (if mufs-vernum
;     (transcript ("Multiuser.library %ld.%ld found" mufs-ver mufs-rev)))
; (if (or (> mufs-ver 39)
;	 (and (= mufs-ver 39) (>= mufs-rev 151)))
;     ((transcript "multiuser.library 1.4 or newer detected")
;      (message
;       "\n    You seem to have MultiUser 1.4 installed. In order to ensure "
;       "the most seamless operation between MultiUser 1.4 and "
;       "the " @app-name " you should do following:\n")
;      (message
;       "\nEither make a link from \"AmiTCP:db/passwd\" to "
;       "MultiUser 1.4 \"passwd\" file, for example with command\n\n"
;       "makelink AmiTCP:db/passwd :multiuser/config/passwd\n\n"
;       "or copy MultiUser 1.4 \"passwd\" file and \"MultiUser.config\" to "
;       "directory \"AmiTCP:db/\", then recreate keyfiles with command\n\n"
;       "makekeyfiles AmiTCP:db/ AmiTCP:db/ vol1: vol2:    \n")))
 (set passwd-source
;      (if (exists "Inet:db/passwd" (noreq)) ; check for AS225r2 compatible
;	  "Inet:db/passwd"
	(tackon source-dir "db/passwd-example"))
; )
 (set group-source (tackon source-dir "db/group-example"))
 (if (>= @user-level 2)
     (message 
      "\n"
      "Copying user database from file"
      "\n\n\"" passwd-source "\"\n\n"
      "and group database from file"
      "\n\n\"" group-source "\"\n\n"))
 (passwd-create)
 (group-create)
; (change-root-password)
 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Installatation sequence
;;;
(message "Please remember during this installation:\n\n"
	 "    Read the instructions provided behind the \"Help\" "
	 "buttons, if you are not absolutely sure what you are doing.\n"
	 "    Please read the files \"README.FIRST\" and "
	 "\"AmiTCP-demo-40.readme\". They contain "
	 "valuable info you cannot afford to miss. (These files are "
	 "shown automatically at the end of the first time installation.)"
	 )

(complete 00) (transcript "On making " app-name ".")
(complete 01) (check-user-level)
(complete 02) (check-system-version)
(complete 03) (check-available-memory)
(complete 04) (check-old-assign)
(complete 05) (select-destination-directory)

(if (exists (tackon conf-dir "resolv.conf"))
    ( ;; Already configured, ask user what s/he wants to do
     (transcript @app-name " already configured, presenting options")
     (while
	 ((complete 10)
	  (set choice
	       (askchoice
		(prompt "The " app-name " seems to be already installed. "
			"Select one of following:")
		(help "    Installer has detected that the file "
		      "\"AmiTCP:db/resolv.conf\" 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 GNUEmacs support files"	; 1
			 "Install NapsaTerm fonts"		; 2
			 "Install user databases"       	; 3
			 "Add new users"                        ; 4
			 "Reconfigure AmiTCP/IP"		; 5
			 "Done")				; 6
		(default 6)))
	  (<> choice 6))
       (select choice
	       ;; (0)
	       (update-devices)
	       ;; (1)
	       (install-emacstcp)
	       ;; (2)
	       (install-napsaterm)
	       ;; (3)
	       (install-user-databases)
	       ;; (4)
	       (add-new-users)
	       ;; (5)
	       ((transcript "Reconfiguring " @app-name ".")
		(complete 20) (ask-default-user)
		(complete 22) (ask-if-dynamic)
		(complete 25) (ask-hostname)
		(complete 35) (ask-interfaces)
		(complete 60) (ask-gateway)
		(complete 65) (ask-nameservers)
		(complete 70) (ask-domains)
		(complete 80) (update-user-startup)
		(complete 90) (create-startup-script)
		(complete 95) (create-config-file) ; This must be the last one!
		))
       )
     )
  ( 
   (complete 08) (ask-accept-licence)	     ; ask if user accepts the licence
   (complete 10) (copy-files-to-destination) ; copy AmiTCP/IP files
   (complete 20) (ask-update-devices)	     ; update Sana-II drivers
   (complete 30) (ask-install-emacstcp)	     ; install EmacsTCP
   (complete 35) (ask-install-napsaterm)     ; install NapsaTerm
   (if (if (if old-atcp-directory
	       (exists (tackon old-atcp-directory "db/AmiTCP.config") 
			(noreq)))
	   ((complete 40)
	    (ask-copy-old-configuration)))
       ((if (exists (tackon conf-dir "passwd"))
	    (transcript "There is already a user database.")
	  ((complete 70)
	   (install-user-databases))) ; install passwd/group
;	(complete 80) (ask-default-user)
	(complete 90) (update-user-startup)
	)
     (;; First time installation (or old version is < 4), do it all
      (if (exists (tackon conf-dir "passwd"))
	  (transcript "There is already a user database.")
	((complete 40)
	 (install-user-databases))) ; install passwd/group

      ;; Configure AmiTCP/IP
      (complete 45) (ask-default-user)
      (complete 50) (ask-if-dynamic)
      (complete 52) (ask-hostname)
      (complete 60) (ask-interfaces)
      (complete 75) (ask-gateway)
      (complete 80) (ask-nameservers)
      (complete 85) (ask-domains)
      (complete 90) (update-user-startup)
      (complete 95) (create-startup-script)
      (complete 96) (create-config-file)))	; This must be the last one!
   ;; show something
   (run (cat "run " pager-cmd) (tackon atcp-assign "AmiTCP-demo-40.readme") (safe))
   (run (cat "run " pager-cmd) (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 "the " @app-name " should be running. If this is not a case, "))
      "type \"startnet"
      (if is-if-dynamic " <current-IP-address>")
      "\" in a command shell to start the "
      @app-name ".")

; EOF
