Evlan
ServerManager
Last updated at 2005/07/10 22:24:24 PDT by Temporal

This is the module "fateofio.org/manager/ServerManager", a helper module used to set up web servers.

# Io Community Manager - Web Application for Managing Open Projects
# Copyright (C) 2005 Kenton Varda
# <http://www.fateofio.org>
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version
# 2 of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this program; if not, write to the Free
# Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA
# ====================================================================

ServerManager where
   #This is a helper module for running a web server.  It was written
   #for convenience, providing a simple way to set up some common
   #server configurations.  You can create far more diverse and
   #powerful configurations by building a server manually.
   ServerManager = object of
      #Make a new server.
      #
      #For [system], pass the system object given to the administrator
      #account by the Evlan VM.  (Note that, for correct capability-based
      #security, you normally shouldn't do such a thing, but again this
      #module is written for ease-of-use over security.)
      #
      #[loginHostname] should be the host name of the virtual host which
      #should handle authentication.  This should be something like
      #"login.example.com" or "localhost:8080" and must be separate from
      #all other host names you intend to use.  If [useHttpsLogin] is
      #true, users will be made to use HTTPS when accessing this host.
      #To allow this, you will have to set up SSL via Stunnel and you
      #should use a certificate matching [loginHostname].
      #
      #[serverName] and [adminEmail] are strings which are included in an
      #e-mail sent to users when they request a new password.  The first
      #line is "This is an automated message from [serverName].".  This
      #is the only part of the e-mail which identifies your server, so
      #you should insure that all users will recognize it.  [adminEmail]
      #is given as an e-mail address which should be contacted if users
      #suspect that the password generation feature is being abused,
      #either in an attempt to "hack" an account or just as an annoyance.
      #This should probably be *your* e-mail address.
      make = (system, loginHostname, useHttpsLogin, serverName, adminEmail) => do
         hostMapper := ServletUtilities.makeHostMapper()
         logger = object of
            write = Task.logMessage
            writeError = Task.logError
            writeWarning = Task.logWarning
         server := HttpServer.make(system.clock, logger, hostMapper)
         hosts := Variable.make(MutableMap.make(String.isBefore))
         ports := Variable.make(MutableMap.make(String.isBefore))
         
         loginPrefix = if useHttpsLogin then "https://" else "http://"
         authenticator := Authenticator.make(
            system.getEntropy, system.userManager,
            Array.join({loginPrefix, loginHostname, "/auth"}),
            serverName, adminEmail, {})
         loginMapper := ServletUtilities.makePathMapper()
         loginMapper.map("auth", authenticator)
         hostMapper.map(loginHostname, loginMapper)
         
         statistics := Statistics.make(Maybe.make("/stats-style"))
         statsMapper := ServletUtilities.makePathMapper()
         statsMapper.mapDefault(statistics)
         statsMapper.map("stats-style",
            ServletUtilities.makeFile(import "stats-stylesheet.css",
               "stats-stylesheet.css", "text/css; charset=UTF-8", 3600*24))
         
         storage := system.storage.createDirectory("www")
         filesystem := HttpFilesystem.make(system.clock, storage)
         
         return makeInterface(system, server, hostMapper, authenticator, statistics,
                              logger, filesystem, statsMapper, hosts, ports)
   
   MutableSet       = import "/evlan.org/utility/MutableSet"
   MutableMap       = import "/evlan.org/utility/MutableMap"
   ServletUtilities = import "/evlan.org/servlet/Utilities"
   HttpServer       = import "/evlan.org/protocol/http/Server"
   Authenticator    = import "/evlan.org/servlet/authenticator/Authenticator"
   Statistics       = import "/evlan.org/servlet/logger/Logger"
   HttpFilesystem   = import "/evlan.org/servlet/files/HttpFilesystem"
   FilesServer      = import "/evlan.org/servlet/files/Server"
   FilesEditor      = import "/evlan.org/servlet/files/Manager"
   Admin            = import "Admin"
   IocmServlet      = import "/fateofio.org/iopm/Servlet"
   IocmStyle        = import "/fateofio.org/v5/Style"
   IocmContent      = import "/fateofio.org/iopm/node/Content"
   
   makeInterface = (system, server, hostMapper, authenticator, statistics,
                    logger, filesystem, statsMapper, hosts, ports) => interface where
      #This object controls your server.  It has methods which allow
      #you to add and remove hosts and specify what ports to listen to.
      #All of the methods are procedures, and so should be executed
      #using "/do" or ":=".
      interface = object of
         #Tell the server to listen on the given port.  [port] should
         #be a string like "80" or "127.0.0.1:80".  [isSecure] should be
         #true if connections on this port should be considered secure.
         #Note that this is nothing more than a flag; in particular, this
         #does NOT turn on SSL for the port.  For that, you must use
         #something like Stunnel to accept SSL connections and tunnel
         #them to this port.
         listen = (port, isSecure) => do
            listener := system.network.listen(port)
            ports.update(oldState => {newState = oldState.insert(port, listener)})
            doListen =
               try do
                  logger.write(Array.join({"Began listening on port:  ", port}))
                  server.listen(listener, isSecure)
               finally logger.write(Array.join({"Stopped listening on port:  ", port}))
            Thread.make(doListen)
         
         #Stops listening on [port], which was originally opened with
         #listen().  Note that this will not cause already-existing
         #connections to be closed.  Open connections will continue to
         #operate until the client's browser disconnects (usually
         #effected by closing all browser windows) or the connection
         #times out (after five minutes of idleness).  If you really
         #must kill open connections, you will have to do so manually.
         #The easiest way to do this is to save the VM state then
         #restart the VM.
         stopListening = port => do
            listener := ports.update of
               oldState => object of
                  newState = oldState.remove(port)
                  result = oldState.find(port)
            if listener.isEmpty do
               throw notFound error("Not currently listening on that port.")
            listener.value.close()
         
         #Create a new static-file-based virtual host and map it to the
         #given host name.  Once running, you may access "/admin" on the
         #server to set it up.  This also returns an object which can be
         #used to control what users have admin rights and other things.
         makeHost = hostname => do
            app := makeHostInterface(system, filesystem)
            alreadyExists := hosts.update of
               oldState => object of
                  result = oldState.contains(hostname)
                  newState =
                     if result
                        then oldState
                        else oldState.insert(hostname, app)
            if alreadyExists do
               throw alreadyExists error("That hostname is already in use.  Remove it first.")
            
            root := authenticator.filter(statistics.filter(app.components.root), "login")
            hostMapper.map(hostname, root)
            return app
         
         #Create a new Io Community Manager-based virtual host and map it
         #to the given host name.  Additionally, serve media files from
         #mediaHostname, which needs to be a separate host to protect
         #cookies.  (Once IoCM is running, you must edit the site info to
         #set the media host there as well.)  As with makeHost(), you can
         #access some administrative functions at "/admin" on the server.
         #Also like makeHost(), this procedure returns an object which can
         #be used to control administrative rights and other things.
         #
         #Io Community Manager requires a number of support files which
         #you will have to manually upload to "/files".  You will need:
         #   style        - The CSS stylesheet for the site.
         #   script       - Javascript used by IoCM.
         #   colormap     - An image used by the post color chooser.
         #   IoChat       - A Java JAR containing the chat applet.
         #   chat-beep    - A sound file used by the chat applet.
         #   server-icon  - The server's "favorites" icon (favicon.ico).
         #   google-logo  - Google's logo for display in the Google box.
         #                  (Only needed if you enable the Google box.)
         #   icons/blank  - Icons used by IoCM.
         #   icons/locked
         #   icons/minus
         #   icons/plus
         #Feel free to download evlan.org's versions of all these files
         #from:
         #   http://evlan.org/files
         #You may want to customize the stylesheet, of course.
         makeIocmHost = (hostname, mediaHostname) => do
            app := makeIocmInterface(system, hostname, filesystem)
            
            alreadyExists := hosts.update of
               oldState => object of
                  result = oldState.contains(hostname)
                        or oldState.contains(mediaHostname)
                  newState =
                     if result
                        then oldState
                        else oldState.insert(hostname, app)
                                     .insert(mediaHostname, app.mediaApp)
            if alreadyExists do
               throw alreadyExists error("One or both of those hostnames are already in use.  Remove them first.")
            
            root := authenticator.filter(statistics.filter(app.components.root), "login")
            hostMapper.map(hostname, root)
            hostMapper.map(mediaHostname, statistics.filter(app.mediaApp.components.root))
            return app
         
         #Create a new host which will serve statistics for your server.
         #Use the returned object to control what users are allowed to
         #view these stats.
         makeStatsHost = hostname => do
            app := makeStatsInterface(system, statsMapper, filesystem)
            
            alreadyExists := hosts.update of
               oldState => object of
                  result = oldState.contains(hostname)
                  newState =
                     if result
                        then oldState
                        else oldState.insert(hostname, app)
            if alreadyExists do
               throw alreadyExists error("That hostname is already in use.  Remove it first.")
            
            root := authenticator.filter(statistics.filter(app.components.root), "login")
            hostMapper.map(hostname, root)
            return app
         
         #Get the object originally returned by one of the make*
         #procedures for the given hostname, incase you lost it.
         getHost = hostname => do
            currentState := hosts.get()
            result = currentState.find(hostname)
            if result.isEmpty do
               throw notFound error("That host name is not mapped.")
            return result.value
         
         #Remove a mapped host.
         removeHost = hostname => do
            exists := hosts.update of
               oldState => object of
                  result = oldState.contains(hostname)
                  newState =
                     if result
                        then oldState.remove(hostname)
                        else oldState
            if not exists do
               throw notFound error("That host name is not mapped.")
            hostMapper.unmap(hostname)
         
         
         #Map [hostname] to the web application [app].  [app] should
         #be an object returned by one of the make* procedures.  This
         #allows you to map the same application to multiple hosts, or
         #move an app to a different host.
         linkHost = (hostname, app) => do
            alreadyExists := hosts.update of
               oldState => object of
                  result = oldState.contains(hostname)
                  newState =
                     if result
                        then oldState
                        else oldState.insert(hostname, app)
            if alreadyExists do
               throw alreadyExists error("That host name is already mapped.")
            root := authenticator.filter(statistics.filter(app.components.root), "login")
            hostMapper.map(hostname, root)
         
         #Maps [app] as the default host for the server.  Any requests
         #to this server using an unmapped host name will be mapped to
         #this web app.  [app] should be an object returned by one of
         #the make* procedures.  If you are only hosting one web site
         #on your server, you should probably set it as the default.
         setDefaultHost = app => do
            root := authenticator.filter(statistics.filter(app.components.root), "login")
            hostMapper.mapDefault(root)
         
         #Unmaps any default host previously set using setDefaultHost().
         #Requests for unmapped hosts will go back to returning "404 Not
         #Found" errors.
         resetDefaultHost = () => do
            hostMapper.unmapDefault()
         
         #This object contains the raw objects wrapped by this helper
         #object.  Once you have learned more about how these things work,
         #you may decide that you want to manipulate these directly.  Take
         #a look at the source code for this module to learn more.
         components = object of
            server        = \server
            hostMapper    = \hostMapper
            authenticator = \authenticator
            statistics    = \statistics
            statsMapper   = \statsMapper
            filesystem    = \filesystem
   
   #Helper procedure to construct a static file host.
   makeHostInterface = (system, filesystem) => do
      directory := filesystem.makeDirectory()
      filesServer := FilesServer.make(directory, Maybe.make("/index-style"))
      filesEditor := FilesEditor.make(directory, filesystem, "", Maybe.make("/index-style"))
      
      adminMapper := ServletUtilities.makePathMapper()
      adminMapper.map("files", filesEditor)
      adminMapper.mapDefault(Admin.authorizedServlet)
      adminProtector := ServletUtilities.makeUserMapper()
      adminProtector.map(0, adminMapper)
      adminProtector.mapDefault(Admin.unauthorizedServlet)
      
      mapper := ServletUtilities.makePathMapper()
      mapper.map("admin", adminProtector)
      mapper.mapDefault(filesServer)
      
      mapper.map("index-style",
         ServletUtilities.makeFile(import "index-stylesheet.css",
            "index-stylesheet.css", "text/css; charset=UTF-8", 3600*24))
      
      admins := Variable.make(MutableSet.make(Scalar.isBefore).insert(0))
      
      subHosts := Variable.make(MutableMap.make(String.isBefore))
      subHostManager = makeSubHostManager(system, filesystem, subHosts, mapper)
      
      return interface where
         #This object represents a simple static-file-based host.
         interface = object of
            #Grant administrative rights to the given user.  This will
            #allow the user to access "/admin" on the server.
            addAdministrator = username => do
               userId := system.userManager.getId(username)
               if userId.isEmpty do
                  throw notFound error("No user by that name exists.")
               alreadyExists := admins.update of
                  oldState => object of
                     result = oldState.contains(userId.value)
                     newState =
                        if result
                           then oldState
                           else oldState.insert(userId.value)
               if alreadyExists do
                  throw alreadyExists error("That user is already an administrator.")
               adminProtector.map(userId.value, adminMapper)
            
            #Revoke administrative rights from the given user.
            removeAdministrator = username => do
               userId := system.userManager.getId(username)
               if userId.isEmpty do
                  throw notFound error("No user by that name exists.")
               exists := admins.update of
                  oldState => object of
                     result = oldState.contains(userId.value)
                     newState =
                        if result
                           then oldState.remove(userId.value)
                           else oldState
               if not exists do
                  throw notFound error("That user does not have admin rights.")
               adminProtector.unmap(userId.value)
            
            makeSubHost = subHostManager.makeSubHost
            makeIocmSubHost = subHostManager.makeIocmSubHost
            getSubHost = subHostManager.getSubHost
            removeSubHost = subHostManager.removeSubHost
            linkSubHost = subHostManager.linkSubHost
            
            #This object contains the raw objects wrapped by this helper
            #object.  Once you have learned more about how these things work,
            #you may decide that you want to manipulate these directly.  Take
            #a look at the source code for this module to learn more.
            components = object of
               root           = mapper
               mapper         = \mapper
               directory      = \directory
               adminMapper    = \adminMapper
               adminProtector = \adminProtector
   
   #Helper procedure to construct an IoCM host.
   makeIocmInterface = (system, hostname, filesystem) => do
      directory := filesystem.makeDirectory()
      filesServer := FilesServer.make(directory, Maybe.make("/index-style"))
      filesEditor := FilesEditor.make(directory, filesystem, "/files", Maybe.make("/index-style"))
      
      adminMapper := ServletUtilities.makePathMapper()
      adminMapper.map("files", filesEditor)
      adminMapper.mapDefault(Admin.authorizedServlet)
      adminProtector := ServletUtilities.makeUserMapper()
      adminProtector.map(0, adminMapper)
      adminProtector.mapDefault(Admin.unauthorizedServlet)
      
      mapper := ServletUtilities.makePathMapper()
      mapper.map("admin", adminProtector)
      mapper.map("files", filesServer)
      
      mapper.map("index-style",
         ServletUtilities.makeFile(import "index-stylesheet.css",
            "index-stylesheet.css", "text/css; charset=UTF-8", 3600*24))
      mapper.map("favicon.ico", makeIconHack(filesServer))
      
      admins := Variable.make(MutableSet.make(Scalar.isBefore).insert(0))
      
      iocmStorage := system.storage.createDirectory("iocm")
      filename = String.delimit(String.splitOnCharacter(hostname, ':'), ".")
      siteStorage := iocmStorage.createDirectory(filename)
      
      iocm := IocmServlet.make(IocmStyle, IocmContent.makeDefault(0, 0),
         system.userManager, system.clock, siteStorage, system.getEntropy)
      
      mapper.mapDefault(iocm)
      
      iocm.makeAdministrator("administrator", true)
      iocm.grantRight("administrator", @edit)
      
      subHosts := Variable.make(MutableMap.make(String.isBefore))
      subHostManager = makeSubHostManager(system, filesystem, subHosts, mapper)
      
      return interface where
         #This object represents an Io Community Manager-based host.
         interface = object of
            #Grant administrative rights to the given user.  This will
            #allow the user to access "/admin" on the server.
            addAdministrator = username => do
               userId := system.userManager.getId(username)
               if userId.isEmpty do
                  throw notFound error("No user by that name exists.")
               alreadyExists := admins.update of
                  oldState => object of
                     result = oldState.contains(userId.value)
                     newState =
                        if result
                           then oldState
                           else oldState.insert(userId.value)
               if alreadyExists do
                  throw alreadyExists error("That user is already an administrator.")
               adminProtector.map(userId.value, adminMapper)
            
            #Revoke administrative rights from the given user.
            removeAdministrator = username => do
               userId := system.userManager.getId(username)
               if userId.isEmpty do
                  throw notFound error("No user by that name exists.")
               exists := admins.update of
                  oldState => object of
                     result = oldState.contains(userId.value)
                     newState =
                        if result
                           then oldState.remove(userId.value)
                           else oldState
               if not exists do
                  throw notFound error("That user does not have admin rights.")
               adminProtector.unmap(userId.value)
            
            #Gives a user management priveledges within IoCM.  Normally
            #you should do this through the IoCM web interface, but if
            #you accidentally remove yourself as a manager there, you can
            #use this to restore your status.
            addIocmManager = username => do
               iocm.makeAdministrator(username, true)
               iocm.grantRight(username, @edit)
            
            #This object represents the accompanying media host for an
            #Io Community Manager-based site.  The media host is used to
            #serve files uploaded by users whom you may not trust.  This
            #must be a separate host to insure that files served from here
            #cannot read users' cookies.
            #
            #You can use the server's linkHost() method to map this to a
            #host name.
            mediaApp = object of
               iocmApp = interface
               
               #This object contains the raw objects wrapped by this helper
               #object.  Once you have learned more about how these things work,
               #you may decide that you want to manipulate these directly.  Take
               #a look at the source code for this module to learn more.
               components = object of
                  root = iocm.fileManager
            
            makeSubHost = subHostManager.makeSubHost
            makeIocmSubHost = subHostManager.makeIocmSubHost
            getSubHost = subHostManager.getSubHost
            removeSubHost = subHostManager.removeSubHost
            linkSubHost = subHostManager.linkSubHost
            
            #This object contains the raw objects wrapped by this helper
            #object.  Once you have learned more about how these things work,
            #you may decide that you want to manipulate these directly.  Take
            #a look at the source code for this module to learn more.
            components = object of
               root           = mapper
               mapper         = \mapper
               iocm           = \iocm
               directory      = \directory
               adminMapper    = \adminMapper
               adminProtector = \adminProtector
   
   
   #Helper procedure to create a statistics host.
   makeStatsInterface = (system, statsMapper, filesystem) => do
      protector := ServletUtilities.makeUserMapper()
      protector.map(0, statsMapper)
      protector.mapDefault(Admin.unauthorizedServlet)
      admins := Variable.make(MutableSet.make(Scalar.isBefore).insert(0))
      
      return interface where
         #This object represents a host which serves server statistics.
         interface = object of
            #Grant the given user permission to view the statistics.
            addViewer = username => do
               userId := system.userManager.getId(username)
               if userId.isEmpty do
                  throw notFound error("No user by that name exists.")
               alreadyExists := admins.update of
                  oldState => object of
                     result = oldState.contains(userId.value)
                     newState =
                        if result
                           then oldState
                           else oldState.insert(userId.value)
               if alreadyExists do
                  throw alreadyExists error("That user is already an administrator.")
               protector.map(userId.value, statsMapper)
            
            #Revoke the given user's right to view the statistics.
            removeViewer = username => do
               userId := system.userManager.getId(username)
               if userId.isEmpty do
                  throw notFound error("No user by that name exists.")
               exists := admins.update of
                  oldState => object of
                     result = oldState.contains(userId.value)
                     newState =
                        if result
                           then oldState.remove(userId.value)
                           else oldState
               if not exists do
                  throw notFound error("That user does not have admin rights.")
               protector.unmap(userId.value)
            
            #Allow everyone to view server stats, logged in or not.
            allowPublicAccess = () => do
               protector.mapDefault(statsMapper)
            
            #Return to allowing only authorized users to view stats.
            denyPublicAccess = () => do
               protector.mapDefault(Admin.unauthorizedServlet)
            
            #This object contains the raw objects wrapped by this helper
            #object.  Once you have learned more about how these things work,
            #you may decide that you want to manipulate these directly.  Take
            #a look at the source code for this module to learn more.
            components = object of
               root      = protector
               protector = \protector
   
   #==================================================================
   #This is a helper function which constructs the sub-host management
   #methods which are available from the various host interfaces.
   #That is, both regular file hosts and IoCM hosts have methods
   #called "makeSubHost", "makeIocmSubHost", etc.  Since these are
   #implemented essentially the same for the two types of hosts, the
   #constructors for both call this function to construct those
   #methods, then copy them into their own objects.
   makeSubHostManager = (system, filesystem, subHosts, mapper) => object of
      #Like the server manager's makeHost(), except it puts the host
      #in a sub-directory of the parent host.
      makeSubHost = directoryName => do
         if String.areEqual(directoryName, "files")
          or String.areEqual(directoryName, "login")
          or String.areEqual(directoryName, "admin") do
            throw alreadyExists error("That directory is special and cannot be mapped.")
         
         app := makeHostInterface(system, filesystem)
         alreadyExists := subHosts.update of
            oldState => object of
               result = oldState.contains(directoryName)
               newState =
                  if result
                     then oldState
                     else oldState.insert(directoryName, app)
         if alreadyExists do
            throw alreadyExists error("That directory is already in use.  Remove it first.")
         
         mapper.map(directoryName, app.components.root)
         return app
      
      #Like the server manager's makeIocmHost(), except it puts the
      #host in a sub-directory of the parent host.  Note that the
      #app's media host is not mapped anywhere by this function.
      #For security reasons, the media host must be mapped at a
      #different hostname.  The returned web app contains the member
      #[mediaApp], which represents the media host; you can map this
      #somewhere else yourself.  Alternatively, you can leave the
      #media host unmapped if you do not intend to allow users to
      #upload avatars or submit files.
      makeIocmSubHost = directoryName => do
         if String.areEqual(directoryName, "files")
          or String.areEqual(directoryName, "login")
          or String.areEqual(directoryName, "admin") do
            throw alreadyExists error("That directory is special and cannot be mapped.")
         
         app := makeIocmInterface(system, directoryName, filesystem)
         
         alreadyExists := subHosts.update of
            oldState => object of
               result = oldState.contains(directoryName)
               newState =
                  if result
                     then oldState
                     else oldState.insert(directoryName, app)
         if alreadyExists do
            throw alreadyExists error("That directory is already in use.  Remove it first.")
         
         mapper.map(directoryName, app.components.root)
         return app
      
      #Get the object originally returned by one of the make*
      #procedures for the given subdirectory, incase you lost it.
      getSubHost = directoryName => do
         currentState := subHosts.get()
         result = currentState.find(directoryName)
         if result.isEmpty do
            throw notFound error("That directory name is not mapped.")
         return result.value
      
      #Remove a mapped sub-host.
      removeSubHost = directoryName => do
         exists := subHosts.update of
            oldState => object of
               result = oldState.contains(directoryName)
               newState =
                  if result
                     then oldState.remove(directoryName)
                     else oldState
         if not exists do
            throw notFound error("That directory name is not mapped.")
         mapper.unmap(directoryName)
      
      #Map [directoryName] to the web application [app].  [app] should
      #be an object returned by one of the make* procedures.  This
      #allows you to map the same application to multiple hosts, or
      #move an app to a different host.
      linkSubHost = (directoryName, app) => do
         alreadyExists := subHosts.update of
            oldState => object of
               result = oldState.contains(directoryName)
               newState =
                  if result
                     then oldState
                     else oldState.insert(directoryName, app)
         if alreadyExists do
            throw alreadyExists error("That host name is already mapped.")
         mapper.map(directoryName, app.components.root)
   
   #==================================================================
   #This is just a little hack that redirects requests for favicon.ico
   #to the appropriate uploaded file.
   makeIconHack = filesServer => object of
      get = request => result where
         newUrl = Object.setMembers(request.url, {path = {"server-icon"}})
         newRequest = Object.setMembers(request, {url = newUrl})
         result = filesServer.get(newRequest)
evlan.org © Copyright 2003-2005 Kenton Varda
Powered by Io Community Manager, Evlan, and FreeBSD