#!/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.18.1 2013/10/13 10:33:54 gustafn 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 $remove_count+1 end]
        
        # skip comment lines
        if {[string index $row 0] eq "\#"} {
            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 $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 trim $temp_status] eq "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 { $status ne "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 {$action eq "stop"} {
        for { set x 1} { $x<120} {incr x} {
            
            # show the log
            set logline [read $fileId]
            if { $logline ne "" } {
                puts $logline
            }

            # check daemontools
            svstat_getinfo
            set status [lindex [array get servers ${server}_svc_status] 1]
            if {$status eq "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 { $status eq "up" && $flag eq "-u"} {
            puts "$server is already up"
            return
        }
        if { $status eq "down" && $flag eq "-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 { $logline ne "" } {
                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 {$arg_2 ne "" } {
            start $arg_2
            exit
        }
    }
    stop -
    restart -
    reload {
        if {$arg_2 ne "" } {
            svc_cmd $arg_2 $arg_1
            exit
        }
    }
    status  {   
        status
        if {$arg_2 eq "verbose"} {
            puts $verbose_status
        }
       exit
    }
    add {
        if {$arg_2 ne "" } {
            add $arg_2
            exit
        }
    }
    version -
    help    -
    default {}
}


help
exit