Magazyn Amiga Shareware Floppies/ma51.dms/ma51.adf/AmiTCP_demo_40.lha/AmiTCP-4.0/Install_AmiTCP

Text File | 1994-10-24 | 73.2 KB | 2,245 lines

;;;; 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 6×11 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