Commit b531b0b7 authored by Michael Hanus 's avatar Michael Hanus

CGI registry packaged

parents
*~
.cpm
.curry
Copyright (c) 2018, Michael Hanus
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. Neither the names of the copyright holders nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
html-cgi
========
This package provides support for CGI programming in the HTML library.
It contains the library `HTML.CGI` which is an auxiliary library
to implement danmic web pages with the library `HTML.Base`.
As a prerequisite to execute dynamic web pages, the installation
of the Curry Port Name Server (CPNS) and the HTML/CGI registry
provided by this package is required. This can be easily done
by the commands
> cypm install cpns
> cypm install html-cgi
These commands install the executables `curry-cpnsd` (CPNS demon)
and `curry-cgi` (HTML/CGI registry) in the bin directory of CPM.
These executables are invoked during the execution of a dynamic
web page.
Furthermore, one should also install the package `html` by the command
> cypm install html
This installs the executable `curry-makecgi` which is used
to compile a dynamic web script implemented in Curry.
--------------------------------------------------------------------------
CGI Registry
------------
The CGI registry is a table of all active CGI server processes
implementing dynamic web pages. Such a process is started
when a dynamic web page is accessed on the web server.
To transmit user inputs (provided via CGI) to the corresponding
server process, the executable `curry-cgi` provided by this package
is used.
CGI server processes are automatically started and
terminated (e.g., after 120 minutes of inactivity).
In order to manage these processes manually, one can
access the CGI registry via the executable `curry-cgi`.
The following commands can be used to access CGI server processes:
> curry-cgi show
Shows all currently active servers (name and pids)
> curry-cgi sketch
Sketches the status of all currently active servers
(date of next cleanup and dates of all currently stored event handlers)
> curry-cgi clean
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.
> curry-cgi 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.
> curry-cgi kill
Kills all currently active servers by killing their processes.
This could be used instead of `stop` if some servers do not
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).
The package `html` contains a web script (see the README there)
which can be installed on the web server to execute these commands.
This might be necessary (instead of using `curry-cgi`) if the
web server has its own directory `/tmp` which is not accessible
from processes outside the web server.
Auxiliary files
---------------
/tmp/Curry_CGIREGISTRY : the data stored in the current registry
{
"name": "html-cgi",
"version": "0.0.1",
"author": "Michael Hanus <mh@informatik.uni-kiel.de>",
"synopsis": "Support for CGI programming in HTML libraries",
"category": [ "Web" ],
"license": "BSD-3-Clause",
"licenseFile": "LICENSE",
"dependencies": {
"base": ">= 1.0.0, < 2.0.0",
"cpns": ">= 0.0.1"
},
"compilerCompatibility": {
"pakcs": ">= 2.0.0",
"kics2": ">= 2.0.0"
},
"exportedModules": [ "HTML.CGI" ],
"executable": {
"name": "curry-cgi",
"main": "HTML.CGI.Registry"
},
"source": {
"git": "https://git.ps.informatik.uni-kiel.de/curry-packages/html-cgi.git",
"tag": "$version"
}
}
This diff is collapsed.
------------------------------------------------------------------------------
--- This module contains some configuration definitions for
--- CGI programming support in the HTML library.
---
--- @author Michael Hanus
--- @version November 2018
------------------------------------------------------------------------------
module HTML.CGI.Config
( scriptServerTimeOut, cgiServerRegistry )
where
import Directory ( getTemporaryDirectory )
import FilePath ( (</>) )
-- The timeout (in msec) of the script server.
-- If the port of the application server is not available within the timeout
-- period, we assume that the application server does not exist and we start
-- a new one.
scriptServerTimeOut :: Int
scriptServerTimeOut = 1000
--- The name of the file where registration information for all cgi servers
--- is kept.
--- The registration is used to get an overview on all cgi servers on
--- a machine or to send requests (e.g., cleanup) to all cgi servers.
cgiServerRegistry :: IO String
cgiServerRegistry = do
tmp <- getTemporaryDirectory
return $ tmp </> "Curry_CGIREGISTRY"
------------------------------------------------------------------------
--- A simple command-based manager for CGI servers.
---
--- @author Michael Hanus
--- @version November 2018
------------------------------------------------------------------------
module HTML.CGI.Registry
where
import Directory ( doesFileExist )
import IOExts
import ReadShowTerm
import System
import HTML.CGI
import HTML.CGI.Config ( cgiServerRegistry )
main :: IO ()
main = do
args <- getArgs
case args of
[] -> showUsage
["show"] -> showAllActiveServers >>= putStrLn
["load"] -> cmdForAllServers "Status of " GetLoad >>= putStrLn
["status"] -> cmdForAllServers "Status of " SketchStatus >>= putStrLn
["sketch" ] -> cmdForAllServers "Sketch status of " SketchHandlers
>>= putStrLn
["showall"] -> cmdForAllServers "Status of " ShowStatus >>= putStrLn
["clean"] -> do out <- cmdForAllServers "Clean status of " CleanServer
getAndCleanRegistry
putStrLn out
["stop"] -> do out <- cmdForAllServers "Stop cgi server " StopCgiServer
getAndCleanRegistry
putStrLn out
["kill"] -> killAllActiveServers >>= putStrLn
["stopscript",scriptprog] -> stopActiveScriptServers scriptprog >>= putStrLn
("submit" : margs) -> submitForm margs
_ -> error "Illegal arguments!"
showUsage :: IO ()
showUsage = putStrLn $ unlines $ registryCommands ++ ["", submitParams]
where
submitParams = "submit <url> <cgikey> <serverprog> : submit dynmic web page"
registryCommands :: [String]
registryCommands =
[ "Registry commands:"
, "show : show all currently active servers"
, "load : show load of all currently active servers"
, "status : show status of all currently active servers"
, "sketch : sketches status of all currently active servers"
, "showall : show status of the server with all event handlers"
, "clean : starts cleanup on each server"
, "stop : stop all currently active servers"
, "kill : kill all currently active servers"
, "stopscript <script> : stop all active servers for a cgi script"
]
showAllActiveServers :: IO String
showAllActiveServers = do
let header = "Currently active cgi script servers:"
line = take (length header) (repeat '=')
result <- doForAllServers "" (\_ -> return "")
return (unlines [header, line, result])
killAllActiveServers :: IO String
killAllActiveServers = do
result <- doForAllServers "Killing process of cgi server "
(\ (pid,_,_) -> system ("kill -9 " ++ show pid) >> return "")
getAndCleanRegistry
return (unlines [result, "All active servers killed!"])
--- 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 String
stopActiveScriptServers scriptprog = do
regs <- getAndCleanRegistry
let header = "Stop active servers for cgi script: " ++ scriptprog
stopmsgs <- mapIO stopServer regs
return (unlines (header : stopmsgs))
where
stopServer (_,progname,port) =
if progname == scriptprog
then runCgiServerCmd port StopCgiServer
else return ""
doForAllServers :: String -> ((Int,String,String) -> IO String) -> IO String
doForAllServers cmt action = do
regs <- getAndCleanRegistry
mapIO doForServer regs >>= return . unlines
where
doForServer (pid,progname,port) = do
let title = cmt ++ progname++":\n(pid: "++show pid++", port: "++port++")\n"
catch (action (pid,progname,port) >>= \s -> return (title ++ s))
(\_ -> return title)
cmdForAllServers :: String -> CgiServerMsg -> IO String
cmdForAllServers cmt servercmd =
doForAllServers
cmt
(\ (_,_,port) -> catch (runCgiServerCmd port servercmd)
(\_ -> return ""))
-- Get the registry with active processes and clean up the registry file.
getAndCleanRegistry :: IO [(Int,String,String)]
getAndCleanRegistry = do
registryfile <- cgiServerRegistry
exclusiveIO (registryfile ++ ".lock") $ do
regexists <- doesFileExist registryfile
regs <- if regexists then readQTermListFile registryfile
else return []
aregs <- mapIO (\ (pid,pname,port) -> doesProcessExist pid >>= \pidruns ->
return (if pidruns then [(pid,pname,port)] else [])) regs
let cregs = concat aregs
when (cregs/=regs) $
writeFile registryfile (concatMap (\reg -> show reg ++ "\n") cregs)
return cregs
-- Tests whether a process with a given pid is running.
doesProcessExist :: Int -> IO Bool
doesProcessExist pid = do
status <- system("test -z \"`ps -p "++show pid++" | fgrep "++show pid++"`\"")
return (status>0)
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