;;; -*- Mode:LISP; Package:USER; Base:10; Readtable:ZL -*-


;;; (C) Copyright 1987, LISP MACHINE INC
;;; See filename "Copyright.Text" for more information.
;;; *********************************************************
;;; *********************************************************
;;; *** NOTE: This is an EXAMPLE, not LMI supported code. ***
;;; *** information contained in this example is subject  ***
;;; *** to change without notice. The ways of doing       ***
;;; *** the things contained in the example may change    ***
;;; *** between system releases. Some techniques which    ***
;;; *** are mere examples in one release may become built ***
;;; *** in system features in the next release. Use good  ***
;;; *** judgement when copying these techniques. Most     ***
;;; *** examples have been motivated by specific customer ***
;;; *** requests, and may not be the best engineered      ***
;;; *** or most efficient solution for someone else.      ***
;;; *********************************************************
;;; *********************************************************


(defsystem nfs
  (:component-systems netpkg))

(load "dj:gjcx.pkg;load" :set-default-pathname nil)


(defvar *nfs-procs* (list (list "port mapper" 'sun:run-port-mapper nil)
			  (list "mount server" 'sun:run-mount-server nil)
			  (list "nfs server" 'sun:run-nfs-server nil)))

(defun boot-nfs (&optional (localp t))
  (or sun:*filesys* (sun:boot-filesys))
  (kill-nfs-procs)
  (mapcar #'(lambda (x)
	      (when (or (not localp) (not (eq (cadr x) 'sun:run-nfs-server)))
		(setf (caddr x) (process-run-function (car x) (cadr x)))))
	  *nfs-procs*)
  (and localp
       (let ((rpc:*rpc-server-trace* t))
	 (send-if-handles terminal-io :set-more-p nil)
	 (send-if-handles terminal-io :set-deexposed-typeout-action :permit)
	 (sun:run-nfs-server))))

(defun kill-nfs-procs ()
  (mapcar #'(lambda (x)
	      (when (and (caddr x) (eq (car x) (si:process-name (caddr x))))
		(send (caddr x) :kill)
		(setf (caddr x) nil)))
	  *nfs-procs*))