'$Revision:$'
 '
Copyright 1992-2006 Sun Microsystems, Inc. and Stanford University.
See the LICENSE file for license information.
'


 '-- Module body'

 'globals modules' <~ (|
    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         webserver = bootstrap define: 'globals modules webserver' ToBe: bootstrap addSlotsTo: (
             bootstrap remove: 'directory' From:
             bootstrap remove: 'fileInTimeString' From:
             bootstrap remove: 'myComment' From:
             bootstrap remove: 'postFileIn' From:
             bootstrap remove: 'revision' From:
             bootstrap remove: 'subpartNames' From:
             globals modules init copy ) From: bootstrap setObjectAnnotationOf: 'globals modules webserver' From: ( |
             {} = 'ModuleInfo: Creator: globals modules webserver.

CopyDowns:
globals modules init. copy 
SlotsToOmit: directory fileInTimeString myComment postFileIn revision subpartNames.

\x7fIsComplete: '.
            | ) .} 

 |)

 'globals modules webserver' <~ (|
    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot\x7fVisibility: public'
        
         directory <- 'applications'.} 


    
     { 'ModuleInfo: Module: webserver InitialContents: InitializeToExpression: (_CurrentTimeString)\x7fVisibility: public'
        
         fileInTimeString <- _CurrentTimeString.} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         myComment <- ''.} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         postFileIn = ( |
            | resend.postFileIn).} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot\x7fVisibility: public'
        
         revision <- '$Revision:$'.} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot\x7fVisibility: private'
        
         subpartNames <- ''.} 

 |)

 'globals' <~ (|
    
     { 'Category: applications\x7fModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         webserver <- bootstrap setObjectAnnotationOf: 'globals webserver' From: ( |
             {} = 'ModuleInfo: Creator: globals webserver.
'.
            | ) .} 

 |)

 'globals webserver' <~ (|
    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         about = bootstrap setObjectAnnotationOf: 'globals webserver about' From: ( |
             {} = 'ModuleInfo: Creator: globals webserver about.
'.
            | ) .} 

 |)

 'globals webserver about' <~ (|
    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         help = '
This is the webserver for Self 4.3.

Register a servlet then start up.

As an example

webserver registerServlet: (webserver exampleServlets fileServlet copy) at: .
webserver start.

fileServlet has a baseDirectory you may wish to set.

When finished, webserver stop.



'.} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         shortName = 'A Self Webserver'.} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         version = 1.} 

 |)

 'globals webserver' <~ (|
    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         deregisterServletAt: u = ( |
            | private removeServletAt: s).} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         exampleServlets = bootstrap setObjectAnnotationOf: 'globals webserver exampleServlets' From: ( |
             {} = 'ModuleInfo: Creator: globals webserver exampleServlets.
'.
            | ) .} 

 |)

 'globals webserver exampleServlets' <~ (|
    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         fileServlet = bootstrap setObjectAnnotationOf: 'globals webserver exampleServlets fileServlet' From: ( |
             {} = 'ModuleInfo: Creator: globals webserver exampleServlets fileServlet.
'.
            | ) .} 

 |)

 'globals webserver exampleServlets fileServlet' <~ (|
    
     { 'ModuleInfo: Module: webserver InitialContents: InitializeToExpression: (\'~/Sites/\')'
        
         baseDirectory <- '~/Sites/'.} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         handleUrl: u = ( |
             f.
             fn.
            | 
            (u = '') ifTrue: [fn: 'index.html'] IfFalse: [fn: u]. 
            (fn last = '/') ifTrue: [fn: fn, 'index.html'].
            fn: baseDirectory, fn.
            f: os_file deadCopy openForReading: fn IfFail: [^ 'Not Found:', fn].
            f contents).} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         parent* = 'traits clonable'.} 

 |)

 'globals webserver exampleServlets' <~ (|
    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         lobbyBrowserServlet = bootstrap setObjectAnnotationOf: 'globals webserver exampleServlets lobbyBrowserServlet' From: ( |
             {} = 'ModuleInfo: Creator: globals webserver exampleServlets lobbyBrowserServlet.
'.
            | ) .} 

 |)

 'globals webserver exampleServlets lobbyBrowserServlet' <~ (|
    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         appropriateSigilFor: slot = ( |
            | 
            ( slot mirror at: (slot name, ':') IfAbsent: [^ ' = '] ) 
              value = mirrors assignment ifTrue: [^ ' &larr; '].
            ' = ').} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         getMirrorAtPath: p = ( |
             o.
            | 
            o: reflect: lobby.
            p do: [|:n| o:(o at: n) contents].
            o).} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         handleUrl: u = ( |
             o.
             r.
             t.
            | 
            u = '' 
              ifTrue: [o: reflect: lobby]
              False: [
                o: getMirrorAtPath: 
                  u asTokensSeparatedByCharactersSatisfying: [|:c | c = '/']].
            htmlFor: o).} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         htmlFor: o = ( |
             r.
            | 

            r: '<html><body><h1>', (o evalName), '</h1><p>'.
            r: r, '<i>', (o comment), '</i><p>'.
            r: r, 'CopyDowns: ', (o copyDowns printString), '<p>'.
            r: r, 'CreatorPath: ', (o creatorPath printString), '<p>'.
            r: r, 'ModuleNames: ', (o moduleNames printString), '<p>'.

            r: r, 'Parents:<ul>'.
            o parentsDo: [|:i| r: r, htmlForSlot: i].
            r: r, '</ul>Slots:<ul>'.
            o withoutAssignmentSlotsDo: [|:i| 
                i isParent ifFalse: [r: r, htmlForSlot: i]].

            r).} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         htmlForSlot: s = ( |
            | 
            '<li><a href="', 
             s key, '/">', 
             s key, '</a>', (appropriateSigilFor: s),
             s value safeName, '</li>').} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         parent* = 'traits clonable'.} 

 |)

 'globals webserver' <~ (|
    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         isRunning = ( |
            | private continue).} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         parent* = 'traits oddball'.} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         private = bootstrap setObjectAnnotationOf: 'globals webserver private' From: ( |
             {} = 'ModuleInfo: Creator: globals webserver private.
'.
            | ) .} 

 |)

 'globals webserver private' <~ (|
    
     { 'ModuleInfo: Module: webserver InitialContents: InitializeToExpression: (false)'
        
         continue <- 'globals false'.} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         debug = 'globals false'.} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         handleRequest: io = ( |
             url.
            | 
            [|i|
              i: io readLine. 
              i print.
              (i matchesPattern: 'GET *') ifTrue: [
                url: i copyFrom: 5 UpTo: i size - 10].
              i first asByte = 13] whileFalse: [].
            io writeLine: ''.
            io writeLine: (handleUrl: url).
            io close.
            self).} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         handleUrl: url = ( |
             s.
            | 
            servlets keys do: [|:k| 
              (k isPrefixOf: url) || (k = '') ifTrue: [
                ^ (servlets at: k) handleUrl: (url copyFrom: k size UpTo: url size)]].
            'Servlet Not Found').} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         parent* = 'traits oddball'.} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         registerServlet: s At: urlStub = ( |
            | 
            servlets isNil ifTrue: [servlets: dictionary copy].
            servlets at: urlStub Put: s.
            self).} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         removeServletAt: u = ( |
            | 
            servlets removeKey: u.
            self).} 


    
     { 'ModuleInfo: Module: webserver InitialContents: InitializeToExpression: (os_file deadCopy)'
        
         serverSocket <- os_file deadCopy.} 


    
     { 'ModuleInfo: Module: webserver InitialContents: InitializeToExpression: (nil)'
        
         servlets.} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         start = ( |
             port = 8080.
            | 
            continue: true.
            serverSocket closeIfFail: [].
            serverSocket:
              os_file
                openTCPListenerOnPort: port      "HARDWIRED!"
                IfFail: [|:e|
                     (e matchesPattern: '*UNKNOWN 125*')
                  || [e matchesPattern: '*EADDRINUSE*']
                     ifTrue: [error: e, '\n',
                                'Warning: couldn\'t start the rself server process.\n',
                                'The port (', port printString, ') is already in use, ',
                                'probably by another Self server.\n\n',
                                'If you wish to start it, kill the other one off and\n',
                                'evaluate "socketServer start"'.
                              ^self]
                      False: [^error: 'Couldn\'t start self server: ', e]].
            'Server started.' printLine.
            [continue] whileTrue: [| io <- unixGlobals os_file. |
            serverSocket initialize: 'server socket'.
                io: serverSocket acceptConnection.
                (message copy receiver: self 
                              Selector: 'handleRequest:' 
                                  With: io) fork resume.
            ].
            serverSocket close.
            'Server terminated.' printLine.
            self).} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         stop = ( |
            | 
            debug ifTrue: ['forcing a stop' printLine].
            serverSocket closeIfFail: [].
            continue: false.
            self).} 

 |)

 'globals webserver' <~ (|
    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         registerServlet: s At: u = ( |
            | private registerServlet: s At: u).} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         start = ( |
            | private start).} 


    
     { 'ModuleInfo: Module: webserver InitialContents: FollowSlot'
        
         stop = ( |
            | private stop).} 



 '-- Side effects'

 globals modules webserver postFileIn