Overview | Index by: file name | procedure name | procedure call | annotation
ntp-1.0.tm (annotations | original source)

#
#    Copyright (C) 2010 Alexandros Stergiakis <alsterg@gmail.com>
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU Affero General Public License as
#    published by the Free Software Foundation, either version 3 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 Affero General Public License for more details.
#
#    You should have received a copy of the GNU Affero General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

#//#
# The "ntp" module defines commands for clock configuration, calendar, and Network Time Protocol (NTP) Client Support.
#//#

module require base 1.0
module provide ntp 1.0

namespace eval ::module::ntp {
namespace import ::helper::* ::module::api::*

proc description {} {
    return "Clock, Calendar & NTP Support"
}

proc version {} {
    
}

proc check {} {
    foreach feature [list \
                     CONFIG_HWCLOCK \
                     CONFIG_DATE \
                     CONFIG_FEATURE_DATE_ISOFMT \
                     CONFIG_RDATE] {
        if {! [::helper::busybox_has $feature]} { ;# Can return error.
            error "Busybox doesn't have support for $feature."
        }
    }
}

proc reset {} {
    variable TZ_FILE
    
    # Default timezone: UTC
    fileutil::writeFile $TZ_FILE "UTC"
    
    # A list that holds the timezone information configure via the
    # 'clock timezone' command. If empty, no timezone is configured.
    variable time_zone {}
    
    # A list that holds the summer time information configure via the
    # 'clock summer-time' command. If empty, no summer-time is configured.
    variable summer_time {}
    
    variable ntp_server {}
}

proc constructor {} {
    log::Info "Loading \"ntp\" module: [description]"
    
    Global ETC_DIR
    variable TZ_FILE [file join $ETC_DIR TZ]
    
    check

    reset

    # Finally load Command Specs
    sysconf loadspecs "modules/ntp/ntp.specs"
    
    # Set system clock from hardware clock.
    # If hardware clock not available or not set, ignore.
    exec hwclock -l -s
}

proc destructor {} {
    # First unload Command Specs
    sysconf remove "ntp"
    
    reset
}

################
# Handlers
################

################################
# Clock & Calendar
################################

# This is the local time, after any timezone.
# @todo after 'clock set' is entered for execution, some extra new lines are printed.
command ClockSet {cmdline argstart sid out no arguments args} {
    set time [dict get $arguments TIME]
    if {[catch {clock scan $time -format %T} errMsg]} {
        ferror "erroneous time" [getpos TIME]
    }
    
    set day [dict get $arguments DAY]
    if {[catch {clock scan $day -format %d} errMsg]} {
        ferror "erroneous day" [getpos DAY]
    }
    
    set month [dict get $arguments MONTH]
    if {[catch {clock scan $month -format %b} errMsg]} {
        ferror "erroneous month" [getpos MONTH]
    }
    
    set year [dict get $arguments YEAR]
    if {[catch {clock scan $year -format %Y} errMsg]} {
        ferror "erroneous year" [getpos YEAR]
    }
    
    set clck [clock scan "$time $day $month $year" -format {%T %d %b %Y}]
    
    # Format accepted by 'date': 2003.08.14-19:50:00
    set frmt [clock format $clck -format {%Y.%m.%d-%H:%M:%S}]
    
    exec date $frmt
}

# @see http://www.gnu.org/software/libtool/manual/libc/TZ-Variable.html
# @todo Timezone abbreviation is not set in TZ variable.
# @diff Sign is a separate argument and not embedded in the offsets.
command ClockTimezone {cmdline argstart sid out no arguments args} {
    variable TZ_FILE
    variable time_zone
    
    if {$no} {
        variable summer_time
        set ::env(TZ) {}
        set time_zone {}
        set summer_time {}
        return
    }
    
    # @todo Currently the TIMEZONE argument is rather tricky. I don't know which abbreviations
    # are valid, and will be accepted from uclibc (via the TZ env variable). Also since it is also
    # mandatory to specify the offset from UTC, it is unclear to me what's the purpuse of
    # of the timezone name. Currently we accept it, but make no use of it, other than being listed
    # in the configuration file. The TZ variable will always be set with UTC as the timezone name.
    set tz [dict get $arguments TIMEZONE]
    # Check that is recognized by Tcl.
    if {[catch {clock scan $tz -format %Z} errMsg]} {
        ferror "erroneous timezone string" [getpos TIMEZONE]
    }
    
    set sign [dict get $arguments SIGN]
    set hours [dict get $arguments HOURS]
    if {[dict exists $arguments MINUTES]} {
        set mins [dict get $arguments MINUTES]
    } else {
        set mins 0
    }
    
    if {! ([string is integer $hours] && (0 <= $hours < 24))} {
        ferror "must be an integer in the range: 0..23" [getpos HOURS]
    }

    if {! ([string is integer $mins] && (0 <= $mins < 60))} {
        ferror "must be an integer in the range: 0..59" [getpos MINUTES]
    }
    
    set hours [format {%02d} $hours]
    set mins [format {%02d} $mins]
    
    # By setting it here it takes effect imediately in this process,
    # (all threads and interpreters), as well as any new child process
    # (with exec or fork).
    set ::env(TZ) "UTC${sign}${hours}:${mins}"
    fileutil::writeFile $TZ_FILE $::env(TZ)
    set time_zone [list $tz $sign $hours $mins]
    return
}

proc print_ClockTimezone {} {
    variable time_zone
    if {! [lempty $time_zone]} {
        return "clock timezone $time_zone\n"
    }
    return
}

# Will not take effect until timezone is set first with 'clock timezone' command.
# @see a
# @limit The 'clock summer-time <zone> date ...' version of the command is not supported.
# @diff In the recurring form, the day,week,month,time are mandatory.
command ClockSummertime {cmdline argstart sid out no arguments args} {
    variable TZ_FILE
    variable summer_time
    variable time_zone

    if {$no} {
        set summer_time {}
        if {! [lempty $time_zone]} {
            lassign $time_zone tz sign hours mins
            set ::env(TZ) "UTC${sign}${hours}:${mins}"
        } else {
            set ::env(TZ) {}
        }
        return
    }

    if {[lempty $time_zone]} {
        error "please set the timezone first"
    }
    
    set tz [getval TIMEZONE]
    lassign [getall WEEK] sweek eweek
    lassign [getall DAY] sday eday
    lassign [getall MONTH] smonth emonth
    lassign [getall TIME] stime etime
    set offset [getval OFFSET {}]

    # TIMEZONE
    if {[catch {clock scan $tz -format %Z} errMsg]} {
        ferror "erroneous timezone" [getpos TIMEZONE]
    }
    
    # START DATE
    if {! [string is integer $sweek] || ! (1 <= $sweek <= 5)} {
        ferror "start week must be in the range 1..5" [getpos WEEK]
    }
    if {! [string is integer $sday] || ! (0 <= $sday <= 6)} {
        ferror "start day must be in the range 0..6" [getpos DAY]
    }
    if {! [string is integer $smonth] || ! (1 <= $smonth <= 12)} {
        ferror "start month must be in the range 1..12" [getpos MONTH]
    }
    if {[catch {
        clock scan $stime -format %T
    }]} {
        ferror "start time must be in the format HH:MM:SS" [getpos TIME]
    }

    # END DATE
    if {! [string is integer $sweek] || ! (1 <= $eweek <= 5)} {
        ferror "end week must be in the range 1..5" [getpos WEEK 1]
    }
    if {! [string is integer $eday] || ! (0 <= $eday <= 6)} {
        ferror "end day must be in the range 0..6" [getpos DAY 1]
    }
    if {! [string is integer $emonth] || ! (1 <= $emonth <= 12)} {
        ferror "end month must be in the range 1..12" [getpos MONTH 1]
    }
    if {[catch {
        clock scan $etime -format %T
    }]} {
        ferror "end time must be in the format HH:MM:SS" [getpos TIME 1]
    }
    
    # OFFSET
    if {[lempty $offset]} {
        set offset 0
    } elseif {! [string is integer $offset] || ! (0*60 <= $offset <= 23*60)} {
        ferror "offset must be in the range 0..23" [getpos OFFSET]
    }
    set hours [format {%02d} [expr {$offset / 60}]]
    set mins [format {%02d} [expr {$offset % 60}]]

    lassign $time_zone tz sign hrs mns
    set ::env(TZ) "UTC${sign}${hrs}:${mns}:00${tz}+${hours}:${mins}:00,M${smonth}.${sweek}.${sday}/${stime},M${emonth}.${eweek}.${eday}/${etime}"
    fileutil::writeFile $TZ_FILE $::env(TZ)
    set summer_time [list $tz $sweek $sday $smonth $stime $eweek $eday $emonth $etime $offset]
    sputs $::env(TZ)
    return
}

proc print_ClockSummertime {} {
    variable summer_time
    if {! [lempty $summer_time]} {
        lassign $summer_time timezone sweek sday smonth stime eweek eday emonth etime offset
        return "clock summer-time $timezone recurring $sweek $sday $smonth $stime $eweek $eday $emonth $etime $offset\n"
    }
    return
}

command ClockReadcal {cmdline argstart sid out no arguments args} {
    # -s : Set system time from hardware clock
    # -l : Set hardware clock to system time
    exec hwclock -l -s
}

# @diff No "calendar set" command. "clock update-calendar" is the only way to write to the calendar.
command ClockUpdatecal {cmdline argstart sid out no arguments args} {
    # -w : Set hardware clock to system time
    # -l : Set hardware clock to system time
    exec hwclock -l -w
}

command ShClock {cmdline argstart sid out no arguments args} {
    clock format [clock seconds] -format {%a %b %d %H:%M:%S %Z %Y}
}

command NtpSever {cmdline argstart sid out no arguments args} {
    variable ntp_server
    
    set host [dict get $arguments HOST]
    if {! [ishostname $host] && ! [isip $host]} {
        ferror "illegal IP address or hostname" [getpos HOST]
    }
    
    set ntp_server $host
    exec rdate -s $host
}

proc print_NtpSever {} {
    variable ntp_server
    
    if {! [lempty $ntp_server]} {
        return "ntp server $ntp_server\n"
    }
    return
}

} ;# End of Namespace

Overview | Index by: file name | procedure name | procedure call | annotation
File generated 2010-03-13 at 22:28.