Commit 1d8c93e0 authored by Michael Hanus 's avatar Michael Hanus
Browse files

cpns demon and www added to tools (and removed from root dir of Curry system)

parent d92889bf
......@@ -14,6 +14,7 @@ casc/CASC
casc/Docs/curry-style-guide.html
CASS/cass
CASS/cass_worker
cpns/CPNSD
createmakefile/CreateMakefile
curry2js/Curry2JS
currypp/Main
......@@ -30,4 +31,6 @@ optimize/binding_optimization/BindingOpt
runcurry/RunCurry
spicey/spiceup
verification/ToVerifier
www/Registry
www/SubmitForm
xmldata/Data2Xml
------------------------------------------------------------------------
--- This is the main program of the CPNS demon.
---
--- @author Michael Hanus
--- @version June 2012
------------------------------------------------------------------------
import qualified CPNS
-- Everything is implemented in the library CPNS:
main :: IO ()
main = CPNS.main
# Compile the CPNS (Curry Port Name Server) demon
# to support named ports in distributed Curry programs:
TOOL = $(CURDIR)/CPNSD
LOGFILE = "/tmp/CurryPNSD.log"
# set additional options for Profile.getProcessInfos used in CPNS logging:
ifeq ($(CURRYSYSTEM),kics2)
ADD_OPTS = :set rts -T
endif
.PHONY: all compile install clean uninstall show showlog
all: install
compile: $(TOOL)
install: compile
clean:
./stop
$(CLEANCURRY)
rm -f $(TOOL)
uninstall: clean
$(TOOL): $(LIBDIR)/CPNS.curry
$(REPL) $(REPL_OPTS) $(ADD_OPTS) :load CPNSD :save :q
# Show the currently registered ports:
show:
$(TOOL) show
# Show the log file of the demon:
showlog:
cat $(LOGFILE)
This directory contains the scripts for CPNS,
the Curry Port Name Server, which is responsible for managing the
symbolic names assigned to the named ports on a local machine.
start: script to start the CPNS demon on the local machine
This script will be automatically called by curry2prolog.
stop: script to stop the CPNS demon (usually not used)
The implementation of the CPNS demon in Curry is contained in the
system library CPNS (since it is imported by the library Ports)
based on primitive socket operations.
#!/bin/sh
# Start the Curry Port Name Server demon, if it is not already
# started on this machine:
PIDFILE="/tmp/CurryPNSD.pid"
LOGFILE="/tmp/CurryPNSD.log"
LOCKFILE="/tmp/CurryPNSD.lock" # for startup control
CPNSBIN="`dirname "$0"`/CPNSD"
STARTSERVER=no
if test ! -f $PIDFILE ; then
STARTSERVER=yes
else
# test whether the server process is still existent:
PID=`cat $PIDFILE`
touch $PIDFILE # to avoid automatic remove if file is too old
ps -p $PID | fgrep $PID > /tmp/TESTPID$$
if test ! -s /tmp/TESTPID$$ ; then
STARTSERVER=yes
rm -f $PIDFILE
echo "CPNS demon seems to be aborted. I try to restart it..." >&2
fi
rm -f /tmp/TESTPID$$
fi
if [ $STARTSERVER = yes ] ; then
if lockfile -r0 $LOCKFILE ; then
echo "Starting demon for Curry Port Name Server..." >&2
if test ! -f $LOGFILE ; then
# create log file with correct access rights:
touch $LOGFILE
chmod -f 666 $LOGFILE # make log file accessible for everybody
fi
echo "Log information in file '$LOGFILE'" >&2
echo "CPNS demon started at `date`" >> $LOGFILE
echo 1 > $PIDFILE # initialize pid file with existing process
chmod -f 666 $PIDFILE # make the pid file readable for everybody
nohup "$CPNSBIN" start >> $LOGFILE 2>&1 &
echo $! > $PIDFILE # write real cpns process into pid file
lockfile -1 $LOCKFILE # wait for lockfile deletion by CPNS demon startup
rm -f $LOCKFILE
echo "CPNS demon started." >&2
else
echo "CPNS demon seems already started by other process" >&2
echo "If this is not the case, delete file $LOCKFILE" >&2
lockfile -1 $LOCKFILE # wait for lockfile deletion by CPNS demon startup
rm -f $LOCKFILE
fi
fi
#!/bin/sh
# Terminate the Curry Port Name Server demon, if it is not already terminated:
PIDFILE="/tmp/CurryPNSD.pid"
LOCKFILE="/tmp/CurryPNSD.lock" # for startup control
CPNSBIN="`dirname $0`/CPNSD"
if test ! -f $PIDFILE ; then
rm -f $LOCKFILE
echo "CPNS demon does not seem to be started." >&2
exit
elif test ! -f "$CPNSBIN" ; then
rm -f $LOCKFILE
echo "CPNS demon does not seem to be generated." >&2
exit
else
# test whether the server process is still existent:
PID=`cat $PIDFILE`
ps -p $PID | fgrep $PID > /tmp/TESTPID$$
if test ! -s /tmp/TESTPID$$ ; then
rm -f $PIDFILE /tmp/TESTPID$$ $LOCKFILE
echo "CPNS demon seems to be already aborted." >&2
exit
fi
fi
"$CPNSBIN" stop >&2
rm -f $PIDFILE /tmp/TESTPID$$ $LOCKFILE
# Compile programs for managing cgi server processes
# (used by HTML libraries):
REGISTRY = $(CURDIR)/Registry
SUBMITFORM = $(CURDIR)/SubmitForm
.PHONY: all compile install clean uninstall
.PHONY: cleanServers show showload sketch showall stop kill
all: install
install: compile
compile: $(SUBMITFORM) $(REGISTRY)
clean:
$(CLEANCURRY)
rm -f $(SUBMITFORM) $(REGISTRY)
uninstall: clean
$(SUBMITFORM): SubmitForm.curry $(LIBDIR)/HtmlCgi.curry \
$(LIBDIR)/NamedSocket.curry $(LIBDIR)/CPNS.curry
$(REPL) $(REPL_OPTS) :load SubmitForm :save :q
$(REGISTRY): Registry.curry $(LIBDIR)/HtmlCgi.curry
$(REPL) $(REPL_OPTS) :load Registry :save :q
cleanServers:
$(REGISTRY) clean
show:
$(REGISTRY) show
showload:
$(REGISTRY) showload
sketch:
$(REGISTRY) sketch
showall:
$(REGISTRY) showall
stop:
$(REGISTRY) stop
kill:
$(REGISTRY) kill
This directory contains the scripts for managing CGI servers that
are executed to generate dynamic web pages implemented with the library HTML.
The CGI servers manage the event handlers used in dynamic web pages
on the server side. Usually, the servers are automatically started
whenever it is necessary to process a dynamic web page. Since these
processes will not be explicitly terminated, it is sometimes necessary
to consider the set of all servers on a machine in order to control
their resources. This is the purpose of the commands in this directory.
The following shell commands can be used to manage the CGI server processes:
> make show
Shows all currently active servers (name and pids)
> make sketch
Sketches the status of all currently active servers
(date of next cleanup and dates of all currently stored event handlers)
> make cleanServers
Starts a cleanup on each server (usually, this is implicitly started
whenever a dynamic web page is requested), i.e., expired event handlers
are deleted. Morever, servers which are inactive for a long time
(the exact period is defined in HTML.cgiServerExpiration) are terminated.
Thus, it is a good idea to execute this command periodically, e.g.,
via a cron job.
> make stop
Stops all currently active servers (however, there are automatically
restarted when a user requests the corresponding dynamic web page)
by sending them a termination message.
> make kill
Kills all currently active servers by killing their processes.
This could be used instead of "make stop" if the server don't
react for some reason.
The use of stop/kill might be necessary in order to restart servers
that have required too much resources without free them (which could
be the case if the underlying run-time system does not deallocate
memory).
------------------------------------------------------------------------
--- A simple command-based manager for CGI servers.
---
--- @author Michael Hanus
--- @version March 2012
------------------------------------------------------------------------
import ReadShowTerm
import System
import IOExts
import HtmlCgi
import Directory(doesFileExist)
main :: IO ()
main = do
args <- getArgs
case args of
["show"] -> showAllActiveServers
["showload"] -> cmdForAllServers "Show load of " GetLoad
["sketch" ] -> cmdForAllServers "Sketch status of " SketchHandlers
["showall"] -> cmdForAllServers "Status of " ShowStatus
["clean"] -> cmdForAllServers "Clean status of " CleanServer >>
getAndCleanRegistry >> done
["stop"] -> cmdForAllServers "Stopping cgi server " StopCgiServer >>
getAndCleanRegistry >> done
["kill"] -> doForAllServers "Killing process of cgi server "
(\(pid,_,_) -> system ("kill -9 "++show pid)) >>
getAndCleanRegistry >> done
["stopscript",scriptprog] -> stopActiveScriptServers scriptprog
_ -> putStrLn $ "ERROR: Illegal arguments!"
showAllActiveServers :: IO ()
showAllActiveServers = do
let header = "Currently active cgi script servers:"
putStrLn header
putStrLn (take (length header) (repeat '='))
doForAllServers "" (const done)
--- Stops the active servers for a particular cgi script by sending them
--- a stop message. This operation is used by the installation script
--- "makecurrycgi" to terminate old versions of a server.
stopActiveScriptServers :: String -> IO ()
stopActiveScriptServers scriptprog = do
regs <- getAndCleanRegistry
putStrLn $ "Stop active servers for cgi script: " ++ scriptprog
mapIO_ stopServer regs
where
stopServer (_,progname,port) =
if progname==scriptprog
then do putStrLn $ "...on port: " ++ port
runCgiServerCmd port StopCgiServer
else done
doForAllServers :: String -> ((Int,String,String) -> IO _) -> IO ()
doForAllServers cmt action = do
regs <- getAndCleanRegistry
mapIO_ doForServer regs
where
doForServer (pid,progname,port) = do
putStrLn $ cmt ++ progname++":\n(pid: "++show pid++", port: "++port++")"
catch (action (pid,progname,port) >> done) (const done)
cmdForAllServers :: String -> CgiServerMsg -> IO ()
cmdForAllServers cmt servercmd =
doForAllServers
cmt
(\ (_,_,port) -> catch (runCgiServerCmd port servercmd) (const done))
-- Get the registry with active processes and clean up the registry file.
getAndCleanRegistry :: IO [(Int,String,String)]
getAndCleanRegistry = exclusiveIO (cgiServerRegistry++".lock") $ do
regexists <- doesFileExist cgiServerRegistry
regs <- if regexists then readQTermListFile cgiServerRegistry
else return []
aregs <- mapIO (\ (pid,pname,port) -> isActivePID pid >>= \pidactive ->
return (if pidactive then [(pid,pname,port)] else [])) regs
let cregs = concat aregs
if cregs==regs
then done
else writeFile cgiServerRegistry (concatMap (\reg->show reg++"\n") cregs)
return cregs
-- Is an integer the pid of an existing process?
isActivePID :: Int -> IO Bool
isActivePID pid = do
mypid <- getPID
let tmp = "/tmp/tmp_pakcs_registry_"++show mypid
system ("ps -p "++show pid++" | fgrep "++show pid++" > "++tmp)
pr <- readCompleteFile tmp
system ("rm "++tmp)
return (not (null pr))
------------------------------------------------------------------------
--- This is the main program to start a cgi script by reading the arguments
--- and forwarding them to the cgi server process.
---
--- @author Michael Hanus
--- @version June 2012
------------------------------------------------------------------------
import HtmlCgi
-- Everything is implemented in the library HtmlCgi:
main :: IO ()
main = submitForm
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment