Entry 877

#
# Samantha
#
#    Auteur: Merwin
#   Version: n/a
#

namespace eval samantha {
    set sam(version) 0.1
    set sam(required) [list Tcl msgcat inifile]
    set sam(optional) [list md5 ftp]
    set sam(root) [file dirname [info script]]
    set sam(libs) [file join $sam(root) "libs"]
    set sam(langs) [file join $sam(root) "langs"]
    set sam(protos) [file join $sam(root) "protocols"]
    set sam(scripts) [file join $sam(root) "scripts"]
}

proc samantha::log {message args} {
    
    # samantha::log <message> ?option? ?option? ?...?
    #
    #   Cette commande permet de gérer les logs/messages envoyés par Samantha
    #   dans la console. Plusieurs options sont disponibles:
    #
    #       -notime  - N'afiche pas le timestamp avant le message
    #       -logfile - Spécifie le fichier dans lequel enregistrer le message
    #       -channel - Indique le channel sur lequel envoyer le texte
    #       -nolog   - N'écris pas le message dans un fichier, se contente de
    #                  l'afficher.
    #       -busy    - N'affiche pas le message à l'écran
    #       -fatal   - Arrete l'éxécution du script
    
    options opt $args {-logfile samantha.log} {-channel stdout}
    
    if { ![info exists opt(-notime)] } {
        set message "\[[clock format [clock seconds] -format "%H:%M"]\] $message"
    }
    
    if { ![info exists opt(-nolog)] } {
        try {
            set fileID [open $opt(-logfile) a+]
            puts $fileID $message
            close $fileID
        } catch {
            puts stderr "Error while logging: $::errorMsg"
            puts stderr "$::errorInfo"
        } finally {
            catch "close $fileID"
        }
    }
    
    if { ![info exists opt(-busy)] } {
        puts $opt(-channel) $message
    }
    
    if { [info exists opt(-fatal)] } {
        exit 1
    }
}

proc samantha::loadConfFile {fileName} {
    
    variable conf
    variable sam
    
    # samantha::loadConfFile
    #
    #   Charge un fichier de configuration, c'est un simple source actuellement
    #
    
    source $fileName
    
    # Chargement des fichiers de langue en fonction de la configuration
    msgcat::mclocale $conf(lang)
    msgcat::mcload $sam(langs)
}

proc samantha::unLoadConf {args} {
    
    variable conf
    
    # samantha::unLoadConf
    #
    #   Vide la mémoire des variables de configuration
    #
    #   ATTENTION: Si vous ne rechargez pas un fichier rapidement ça risque de faire
    #   planter Samantha.
    #
    
    unset conf
}

proc samantha::loadIrcdFile {fileName} {
    
    # samantha::loadIrcdFile
    #
    #   Charge un protocole IRCd en mémoire
    #
    
    source $fileName
    
}

proc samantha::ircConnect {args} {
    
    variable conf
    
    # samantha::ircConnect
    #
    #   Lances la connection, et l'authentification au serveur
    #
    
    if { [irc::isConnected] } {
        return
    }
    
    try {
        irc::openSocket $conf(address) $conf(port)
    } catch {
        log "[msgcat::mc IRC_ERRSOCKET $::errorMsg]" -fatal
    }
   
}

proc samantha::ircConnected {ip port} {
    
    variable conf
    
    # samantha::ircConnected
    #
    #   Callback du module IRC une fois la connection établie, on lance
    #   l'authentification au serveur.
    
    log "[msgcat::mc IRC_CONNECTED $conf(address) $conf(port)]"
    irc::sendAuth $conf(name) $conf(pass) $conf(desc)
    callBinds CONNECTED $ip $port
}

proc samantha::ircSynched {args} {
    
    variable conf
    
    # Callback une fois qu'on est synchronisé au serveur, à partir de la on
    # peut créer nos bots, etc.
    
    log [msgcat::mc IRC_SYNCHED]
    callBinds SYNCHED
}

proc samantha::ircEof {args} {
    
    # samantha::ircEof
    #
    #   Le serveur a mis fin à la connection !
    #
    
    log "[msgcat::mc IRC_EOF]"
    callBinds EOF
    exit 1
    
}

########################
## Callback des binds ##
########################

proc samantha::ircAuthed {remoteName myName} {
    callBinds AUTHED $remoteName $myName
}

proc samantha::ircNewServer {name hopcount desc} {
    callBinds SERVER $name $desc
}

proc samantha::ircDelServer {name reason} {
    callBinds SPLIT $name $reason
}

proc samantha::ircNewUser {nick ident host vhost server ip modes name} {
    callBinds CONNECT $nick $ident $host $vhost $server $ip $modes $name
}

proc samantha::ircDelUser {nick reason} {
    callBinds DISCONNECT $nick $reason
}

proc samantha::ircJoined {nick channel} {
    callBinds JOIN $nick $channel
}

proc samantha::ircPart {nick channel {reason ""}} {
    callBinds PART $nick $channel $reason
}

proc samantha::ircKicked {nick channel target {reason ""}} {
    callBinds KICK $nick $channel $target $reason
}

proc samantha::ircNick {nick newnick} {
    callBinds NICK $nick $newnick
}

proc samantha::ircMsg {source bot texte} {
    set stexte [split $texte]
    set command [lindex $stexte 0]
    set arg [join [lrange $stexte 1 end]]
    callBinds MSG $source $bot $command $arg $texte
}

proc samantha::ircPub {source channel texte} {
    set stexte [split $texte]
    set command [lindex $stexte 0]
    set arg [join [lrange $stexte 1 end]]
    callBinds PUB $source $channel $command $arg $texte
}

proc samantha::ircMode {from channel mode target} {
    callBinds MODE $from $channel $mode $target
}

proc samantha::ircUMode {from target mode} {
    callBinds UMODE $from $target $mode
}

proc samantha::init {args} {
    
    variable sam
    variable conf
    
    # samantha::init
    #
    #   Chargement des packages nécéssaires et des librairies !
    #
    
    puts "-- Samantha $sam(version) --"
    
    # Creation de l'interpréteur pour les scripts
    interp create scr
    
    # Chargements des fichiers sources de Samantha
    foreach fileName [glob -directory $sam(libs) -- *.tcl] {
        uplevel #0 [list source $fileName]
        interp eval scr [list source $fileName]
    }
    
    uplevel #0 [list source [file join $sam(root) "scripting.tcl"]]
    
    # Chargement des packages obligatoires
    log "Loading required packages..." -nolog
    foreach pkgName $sam(required) {
        try {
            lappend pkgList "$pkgName [package require $pkgName]"
            interp eval scr [list package require $pkgName]
        } catch {
            log "Unable to load required package $pkgName: $::errorMsg"
            exit 1
        }
    }
    log "Loaded [join $pkgList {, }]"
    
    # Chargements des packages pour le support de certaines options
    try {package require md5}
    try {package require tcltls}
    
    # Initialisation des commandes Tcl pour le scripting
    
    interp alias scr bind {} samantha::bind
    interp alias scr unbind {} samantha::unbind
    interp alias scr getChannelInfo {} samantha::irc::getChannelInfo
    interp alias scr getUserInfo {} samantha::irc::getUserInfo
    interp alias scr sendRaw {} samantha::irc::sendSocketData
    interp alias scr isBot {} samantha::irc::isBot
    interp alias scr isUser {} samantha::irc::isUser
    interp alias scr isOnChan {} samantha::irc::isOnChan
    interp alias scr isServer {} samantha::irc::isServer
    interp alias scr isChannel {} samantha::irc::isChannel
    interp alias scr findUsers {} samantha::irc::findUsers
    interp alias scr getUserList {} samantha::irc::getUserList
    interp alias scr getServerList {} samantha::irc::getServerList
    interp alias scr getServerInfo {} samantha::irc::getServerInfo
    interp alias scr getChannelList {} samantha::irc::getChannelList
    interp alias scr botCreate {} samantha::irc::botCreate
    interp alias scr botJoin {} samantha::irc::botJoin
    interp alias scr botPart {} samantha::irc::botPart
    interp alias scr botQuit {} samantha::irc::botQuit
    interp alias scr botKick {} samantha::irc::botKick
    interp alias scr botOper {} samantha::irc::botOper
    interp alias scr botNick {} samantha::irc::botNick
    interp alias scr botSay {} samantha::irc::botSay
    interp alias scr botChanModes {} samantha::irc::botChanModes
    interp alias scr log {} samantha::log
    interp alias scr rfcToLower {} samantha::irc::getLower
    interp alias scr getScriptInfo {} samantha::getScript
    interp alias scr isSynched {} samantha::irc::isSynched
    interp alias scr isAuthed {} samantha::irc::isAuthed
    interp alias scr isConnected {} samantha::irc::isConnected
    
    # Chargement du fichier de configuration de Samantha
    try {
        loadConfFile "samantha.conf"
        log "[msgcat::mc CONF_LOADED]"
    } catch {
        log "Unable to load configuration file: $::errorMsg"
        log "$::errorInfo" -notime -fatal
    }
    
    # Chargement du protocole IRCd
    try {
        loadIrcdFile [file join $sam(protos) "$conf(proto).tcl"]
        log [msgcat::mc IRCD_LOADED [irc::getProtocolInfo]]
    } catch {
        log "[msgcat::mc IRCD_ERRLOAD $conf(proto) $::errorMsg]"
        log "$::errorInfo" -notime -fatal
    }
    
    # Connection au serveur distant
    ircConnect
    
    
}

samantha::init
vwait _forever_