;;; -*- Mode:Common-Lisp; Package:NET; Base:10; Fonts:(COURIER TR12I TR12BI TR12 MEDFNTB) -*-

;1 File name: UTILITIES.LISP*
;1 Defines some useful constants and functions for use in different protocols.*
;1 Started 2-1-1989 by Eric Karlson, UC-Berkeley under Robert Wilensky*
;1 Phone: (415) 642-9076, E-mail Address: karlson@ucbarpa.berkeley.edu*

;1----------------------*
;1 Some useful constants*
;1----------------------*

(defconstant 4*MAX-PRIV-PORT-NUM* *1023 "2The maximum special valid port number.*")
(defconstant 4*MIN-PRIV-PORT-NUM* *512 "2The minimum special valid port number.*")
(defconstant 4*PASSWORD-FILENAME* *"3PASSWORD.REMOTE#>*" "2A string giving the name of the password file.*")
(defconstant 4*RHOST-FILENAME* *"3HOSTS.REMOTE#>*" "2A string giving the name of the rhost file.*")
(defvar 4*REMOTE-LOG** "3lm:SITE;REMOTE.LOG#>*" "2A log of all remote requests made to this machine.*")
(defvar 4*SHELL-TIMEOUT* *600 "2Time to wait before timing out on connection in 60ths of a second.*")

;1----------------*
;1 Misc functions*
;1----------------*

(defun 4make-privileged-unix-stream *(port initial-stream)
"2Reads a UNIX port number from the indicated stream and returns a stream to that port.*"
  (declare (function make-privileged-unix-stream (FIXNUM STREAM) STREAM)
	   (values RETURN-STREAM))

  ;1 If PORT = 0 then return STDERR back on the initial connection, else open up a new stream to that port number.*
  (if (zerop port)
      initial-stream
      (do ((host (send initial-stream :foreign-host))
	   (local-port *MAX-PRIV-PORT-NUM* (1- local-port))
	   (stream nil))
	  ((or stream (= local-port *MIN-PRIV-PORT-NUM*))
	   (or stream
	       (ferror 'gni-service-error "3Couldn't find a Privileged Port for connecting to port ~D to host ~A*"
		       local-port host)))
	(declare (type HOST host)
		 (type (or NULL STREAM) stream)
		 (FIXNUM local-port))
	(setq stream (condition-case ()
			 (ip:open-stream host
					 :remote-port port
					 :local-port local-port
					 :timeout *SHELL-TIMEOUT*
					 :characters :ascii
					 :direction :output
					 :error NIL)
		       (ip:connection-already-exists nil))))))

(defmacro 4with-open-log *(file-params &body body)
"2Executes the body with LOG-STREAM bond to the opened LOG file.*"
  (declare (function with-open-log (LIST &body LIST) T)
	   (arglist (LOG-STREAM CONNECTION-STREAM TEMP-USER-ID) &body BODY))
  `(let ((USER-ID ,(third file-params)))
     (declare (special USER-ID)
	      (STRING USER-ID))
     ;1 Open the log in APPEND mode if there is one.*
     (with-open-stream (,(first file-params) (if *REMOTE-LOG*
						 (open *REMOTE-LOG* :direction :output
								    :if-exists :APPEND
								    :if-does-not-exist :CREATE)
						 *NULL-STREAM*))
       ;1 Start the log.*
       (multiple-value-bind (sec min hour day month year) (time:get-time)
	 (declare (FIXNUM sec min hour day month year))
	 (format ,(first file-params) "3~2%~2,48D:~2,48D:~2,48D ~D-~D-~D : ~A from ~A*"
		 hour min sec month day year
		 ,(third file-params)
		 (if ,(second file-params)
		     (send ,(second file-params) :foreign-host)
		     "3a connection that closed or something.*")))

       ;1 Execute the Body. Put it inside the LET so that it can have declerations.*
       (let ()
	 . ,body)

       ;1 Log info close*
       (multiple-value-bind (sec min hour day month year) (time:get-time)
	 (declare (FIXNUM sec min hour day month year))
	 (format ,(first file-params) "3; Successfully terminated at ~2,48D:~2,48D:~2,48D ~D-~D-~D*"
		 hour min sec month day year)))))

(defun 4validate-password *(password)
"2Returns T if the password is valid for the given user.*"
;1 To check a password, first USER-ID must have a home directory on this machine. If so, check for*
;1 a file in that directory called PASSWORD.REMOTE. This file should contain a string which is*
;1 the password for this user on this machine.*
  (declare (function validate-password (STRING) SYMBOL)
	   (values T-OR-NIL))
  (let ((dir (send (user-homedir-pathname) :directory-pathname-as-file))
	(pw-file (merge-pathnames *PASSWORD-FILENAME* (user-homedir-pathname))))
    (declare (PATHNAME dir pw-file))
    (when (probe-file dir)
      (with-open-file (fd pw-file :direction :input :if-does-not-exist :CREATE)
	(declare (STREAM fd))
	(let ((local-pw (read-line fd nil nil)))
	  (declare (type (or NULL STRING) local-pw))
	  (and local-pw (string= password local-pw)))))))

(defun 4validate-user *(remote-name connection)
"2Attempts to validate the SHELL request with the given user names. If there are no problems,
the NIL is returned. Otherwise an error message is returned.*"
;1 Notice that case is ignored for the remote hostname, but is significant in the username.*
;1 If there is no valid USER-ID on this machine, then an "Incorrect Login" message is passed back.*
  (declare (function validate-user (STRING STREAM) SYMBOL)
	   (values T-OR-NIL))
  (let ((dir (send (user-homedir-pathname) :directory-pathname-as-file))
	(host-file (merge-pathnames *RHOST-FILENAME* (user-homedir-pathname)))
	(remote-host (send connection :foreign-host))
	start1 end1 start2 end2)
    (declare (PATHNAME dir host-file)
	     (STRING remote-host)
	     (type (or NULL FIXNUM) start1 end1 start2 end2))
    (cond ((not (probe-file dir)) "3Login incorrect*")
	  ((string= USER-ID remote-name) nil)
	  ( T (with-open-file (fd host-file :direction :input :if-does-not-exist :CREATE)
		(declare (STREAM fd))
		(do ((line (read-line fd nil nil) (read-line fd nil nil)))
		    ((null line) "3Permission denied*")
		  (declare (type (or NULL STRING) line))
		  ;1 Extract the two fields in this line and compare them to the input.*
		  (when (setq start1 (position #\SPACE line :test #'char/=))
		    (when (setq end1 (position #\SPACE line :test #'char= :start start1))
		      (when (setq start2 (position #\SPACE line :test #'char/= :start end1))
			(setq end2 (position #\SPACE line :test #'char= :start start2))
			(when (and (string-equal (subseq line start1 end1) remote-host)
				   (string= (subseq line start2 end2) remote-name))
			  (return nil)))))))))))