Index: openacs-4/packages/acs-core-docs/www/files/openacs.txt
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-core-docs/www/files/openacs.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-core-docs/www/files/openacs.txt	16 Apr 2004 12:59:35 -0000	1.1
@@ -0,0 +1,387 @@
+#!/bin/sh
+# hand off to tcl
+# The backslash makes the next line a comment in Tcl \
+exec tclsh "$0" ${1+"$@"}
+
+# program to control OpenACS servers with daemontools
+
+######################################################################
+# initialization
+######################################################################
+
+set version {$Id: openacs.txt,v 1.1 2004/04/16 12:59:35 joela Exp $}
+
+#----------------------------------------------------------------------
+# get command line arguments
+#----------------------------------------------------------------------
+
+set arg_1 [lindex $argv 0] 
+set arg_2 [lindex $argv 1]
+
+#----------------------------------------------------------------------
+# prepare system settings
+#----------------------------------------------------------------------
+
+set server_list_file "/etc/openacs/services"
+
+set service_dir "/service"
+set svc_bin "/usr/bin/svc"
+set svstat_bin "/usr/bin/svstat" 
+
+set web_base "/var/lib/aolserver"
+set verbose_status ""
+set line "----------------------------------------------------------------------\n"
+
+######################################################################
+# Procedure Library
+######################################################################
+
+#----------------------------------------------------------------------
+# inspect services file
+#----------------------------------------------------------------------
+proc init_server_list {} {
+    global servers
+    global verbose_status
+    global hosts
+    global line
+    global server_list_file 
+
+    if { [catch {set fileId [open "$server_list_file"]} result] } {
+        append verbose_status $line
+        append verbose_status "Error reading $server_list_file: $result\n"
+        set file_contents ""
+    } else {
+        set file_contents [string trim [read $fileId] ]	
+        close $fileId
+    }
+    
+    while {[regexp {(.[^\n]+)} $file_contents match_fodder row] } {
+        # remove each row as it's handled
+        set remove_count [string length $row]
+        set file_contents [string range $file_contents [expr $remove_count + 1] end]
+        
+        # skip comment lines
+        if { [string equal [string index $row 0] \#] } {
+            continue
+        }
+        
+        set row_data [split $row {:}]
+        set name        [lindex $row_data 0] 
+        # build an array of all servers in the file
+        array set servers [list "${name}_name" $name \
+                               "${name}_svc_status" "" \
+                               "${name}_time"     "" ]
+
+    }
+
+    svstat_getinfo 
+    return
+
+}
+
+#----------------------------------------------------------------------
+# Inspect the results of svstat
+#----------------------------------------------------------------------
+proc svstat_getinfo {} {
+    global servers
+    global verbose_status
+    global line
+    global svstat_bin
+    global service_dir
+    if { ![catch {set svstat_txt [eval exec $svstat_bin [glob ${service_dir}/*]]} result] } {
+        # pluck out the channel data from svstat:
+        # /service/oacs-5-1: up (pid 21952) 9497 seconds, normally down
+        #          ^^^^^^^^                ^^^^^ 
+        
+        append verbose_status $line
+        append verbose_status "$svstat_txt\n"
+
+        while {[regexp {(.[^\n]+)} $svstat_txt match_fodder row] } {
+            set server ""
+            set svc_status ""
+            set time ""
+            # remove each row as it's handled
+            set remove_count [string length $row]
+            set svstat_txt [string range $svstat_txt [expr $remove_count + 1] end]
+            regexp {/service/(.+):} $row match_fodder server 
+            regexp {:\s([a-z]+)\s} $row match_fodder svc_status
+            regexp {\s([0-9]+)\sseconds} $row match_fodder time 
+
+            set match_list [array names servers ${server}_name]
+
+            if {[llength $match_list] > 0} {
+                array set servers [list ${server}_time $time]
+                array set servers [list ${server}_svc_status [string trim $svc_status]]
+            }
+        }
+    } else {
+        append verbose_status $line
+        append verbose_status "supervise error: $result\n"
+    }
+    return
+}
+
+
+#----------------------------------------------------------------------
+# Help
+#----------------------------------------------------------------------
+
+proc help {}  {
+    global version
+    puts  "$version
+Usage: openacs
+	status              status report for all sites
+        start   {server}    start supervised site
+        stop    {server}    stop supervised site
+        restart {server}    restart daemontools-supervised site
+
+        add     {server}    Add a server for management by 
+                            daemontools
+	status verbose      verbose status report for all sites
+	help                this message
+    "
+}
+
+
+#----------------------------------------------------------------------
+# status report, Mr Sulu
+#----------------------------------------------------------------------
+proc status {} {
+    global servers
+
+    puts  ""
+    puts  "       all servers       |" 
+    puts  "server          |  svc   |" 
+    puts  "                | uptime |" 
+    #      0123456789012345678901234567890123456789012345678901234567890123456789012345
+    puts  "----------------+--------+"
+    set server_name_list [array names servers {*_name}] 
+
+    set real_name_list [list]
+    foreach server $server_name_list {
+        lappend real_name_list [lindex [array get servers $server] 1]
+    }
+
+    set server_list [lsort $real_name_list]
+    foreach server $server_list {
+        set temp_status    [lindex [array get servers ${server}_svc_status] 1]
+
+        if { [string equal [string trim $temp_status] up] } {
+            set svc_status [lindex [array get servers ${server}_time] 1] 
+        } else {
+            set svc_status $temp_status
+        }
+
+        set channel    [lindex [array get servers ${server}_channel] 1]  
+        set    output [list [format %-16.16s $server]]
+	lappend output [format %8.8s    $svc_status]
+        lappend output ""
+        puts [join $output "|"]
+    }
+    return
+}
+
+
+#----------------------------------------------------------------------
+# start
+#----------------------------------------------------------------------
+proc start {server} {
+    global servers
+
+    # if server is not running, start it
+    set status [lindex [array get servers ${server}_svc_status] 1]
+    if { ![string equal $status "up"]} {
+        puts "Server is not up; starting server"
+        svc_cmd $server start
+    }
+
+    return
+}
+
+#----------------------------------------------------------------------
+# svc_cmd
+#----------------------------------------------------------------------
+proc svc_cmd {server action} {
+    global web_base
+
+    global servers
+    global svc_bin
+    global svstat_bin
+    global service_dir
+    set flag [string map {
+        start "-u"
+        stop  "-d"
+        reload "-t"
+        restart "-t"
+    } $action]
+
+    set match_list [array names servers ${server}_name]
+    if {[llength $match_list] < 1} {
+        puts "${server} is not controlled by daemontools"
+        return
+    }
+
+    svstat_getinfo
+    set status [lindex [array get servers ${server}_svc_status] 1]
+
+    set svc_command "$svc_bin $flag [glob ${service_dir}/${server}]"
+
+    if { [catch {set svstat_txt [eval exec $svc_command]} result] } {           
+        puts "Unable to $action server: $result"
+        return
+    }
+
+    # TODO: should open up the config.tcl and find the actual
+    # location of the error log
+    # for now, guess at two common locations
+    set error_log $web_base/${server}/log/error.log
+    if { [catch {set fileId [open $error_log {RDONLY }]} result] } {
+        set error_log $web_base/${server}/log/error-${server}.log
+        if { [catch {set fileId [open $error_log_2 {RDONLY }]} result] } {
+            puts "Problem with the logfile: $result"
+        }
+    }
+
+    fconfigure $fileId -blocking 0
+    # skip to the end of the log file
+    read $fileId
+
+    puts "Doing $action ${server} with: $svc_command "
+    
+    # tried to do this with fileevent and simply couldn't get it to work
+    # so instead we used timed loops.  Stop is based on daemontools;
+    # start and restart are based on a key phrase in the log file
+ 
+    
+    if { [string equal $action stop] } {
+        for { set x 1} { $x<120} {incr x} {
+            
+            # show the log
+            set logline [read $fileId]
+            if { [string length $logline] > 0 } {
+                puts $logline
+            }
+
+            # check daemontools
+            svstat_getinfo
+            set status [lindex [array get servers ${server}_svc_status] 1]
+            if { [string equal $status "down"]} {
+                puts "${server} is down"
+                close $fileId
+                return
+            }
+            # wait a second
+            after 1000
+        }
+        if { $x >= 120 } {
+            puts "gave up waiting after 2 minutes"
+        }
+    } else {
+        if { [string equal $status "up"] && [string equal $flag "-u"]} {
+            puts "$server is already up"
+            return
+        }
+        if { [string equal $status "down"] && [string equal $flag "-t"]} {
+            puts "$server is down; attempting a start instead of a
+            restart"
+            set flag "-u"            
+        }
+
+        puts "scanning $error_log"
+        # check the server log every 100 ms 
+        for { set x 1} {$x<1200} {incr x} {
+            set logline [read $fileId]
+            if { [string length $logline] > 0 } {
+                puts $logline
+                if { [regexp "accepting connections" $logline]} {
+                    close $fileId
+                    return
+                }
+            }
+            if { [regexp Fatal $logline] } {
+                puts "Fatal error - shutting server down"
+                eval exec "$svc_bin -d [glob ${service_dir}/${server}]"
+                break
+            }
+            after 100
+        }
+        if { $x >= 1200 } {
+            puts "gave up waiting after 2 minutes"
+        }
+        
+    }     
+    close $fileId
+    return
+}
+
+#----------------------------------------------------------------------
+# add
+#----------------------------------------------------------------------
+proc add {server} {
+    global server_list_file
+
+    # open it or create control file
+    if { [catch {set fileId [open "$server_list_file" r]} result] } {
+        set file_contents ""
+    } else {
+        set file_contents [string trim [read $fileId] ]	
+        close $fileId
+    }
+
+    set fileId [open "$server_list_file" a+]
+    # check for servername in proper file format
+    set already_exists [regexp $server $file_contents]
+    if { $already_exists } {
+        puts "$server already exists in $server_list_file\n"
+    } else {
+        # put the new entry at the end
+        set fileId [open "$server_list_file" a+]
+        puts $fileId $server
+    }
+    close $fileId
+}
+
+
+######################################################################
+# execution body
+######################################################################
+
+init_server_list
+
+switch -glob -- $arg_1 {
+    start {
+        if {[string length $arg_2] >0 } {
+            start $arg_2
+            exit
+        }
+    }
+    stop -
+    restart -
+    reload {
+        if {[string length $arg_2] >0 } {
+            svc_cmd $arg_2 $arg_1
+            exit
+        }
+    }
+    status  {   
+        status
+        if { [string equal $arg_2 verbose] } {
+            puts $verbose_status
+        }
+       exit
+    }
+    add {
+        if {[string length $arg_2] >0 } {
+            add $arg_2
+            exit
+        }
+    }
+    version -
+    help    -
+    default {}
+}
+
+
+help
+exit
+