From e2c23202ac56363565bc2257af1d078dc6cdbb2c Mon Sep 17 00:00:00 2001 From: Oldes Date: Wed, 20 Jul 2022 13:58:01 +0200 Subject: [PATCH] FEAT: `daytime` scheme: initial version of the Daytime Protocol (RFC-867) --- make/rebol3.nest | 2 + make/tools/make-boot.reb | 2 +- src/boot/sysobj.reb | 1 + src/mezz/prot-daytime.reb | 161 +++++++++++++++++++++++++++++++++++ src/tests/units/port-test.r3 | 12 +++ 5 files changed, 177 insertions(+), 1 deletion(-) create mode 100644 src/mezz/prot-daytime.reb diff --git a/make/rebol3.nest b/make/rebol3.nest index 33af67b5ca..9c4e712076 100644 --- a/make/rebol3.nest +++ b/make/rebol3.nest @@ -737,6 +737,7 @@ include-mezz-colors: [mezz-lib-files: %mezz/mezz-colors.reb ] ; protocols: include-prot-whois: [mezz-prot-files: %mezz/prot-whois.reb ] include-prot-mysql: [mezz-prot-files: %mezz/prot-mysql.reb ] +include-prot-daytime: [mezz-prot-files: %mezz/prot-daytime.reb ] include-prot-https: [mezz-prot-files: %mezz/prot-http.reb :include-prot-tls] include-prot-tls: [ :include-bincode @@ -823,6 +824,7 @@ include-rebol-bulk: [ :include-prot-whois :include-prot-mysql + :include-prot-daytime :include-dialecting ;`delect` :include-native-oid ;`form-oid` diff --git a/make/tools/make-boot.reb b/make/tools/make-boot.reb index f3662affec..5be19c6eaa 100644 --- a/make/tools/make-boot.reb +++ b/make/tools/make-boot.reb @@ -959,7 +959,7 @@ foreach file first mezz-files [ either all [ ;- if protocol exports some function, import must be used so ;- the functions are available in user's context - select hdr 'exports + ;select hdr 'exports select hdr 'name 'module = select hdr 'type ][ diff --git a/src/boot/sysobj.reb b/src/boot/sysobj.reb index 7c2a1001d7..1fb541d1c7 100644 --- a/src/boot/sysobj.reb +++ b/src/boot/sysobj.reb @@ -153,6 +153,7 @@ modules: object [ ;; optional modules, protocol and codecs httpd: https://src.rebol.tech/modules/httpd.reb prebol: https://src.rebol.tech/modules/prebol.reb + daytime: https://src.rebol.tech/mezz/prot-daytime.reb mail: https://src.rebol.tech/mezz/prot-mail.reb mysql: https://src.rebol.tech/mezz/prot-mysql.reb csv: https://src.rebol.tech/mezz/codec-csv.reb diff --git a/src/mezz/prot-daytime.reb b/src/mezz/prot-daytime.reb new file mode 100644 index 0000000000..fca6ae2813 --- /dev/null +++ b/src/mezz/prot-daytime.reb @@ -0,0 +1,161 @@ +Rebol [ + Name: daytime + Type: module + Options: [delay] + Version: 1.0.0 + Date: 20-Jul-2022 + File: %prot-daytime.reb + Title: "Daytime protocol scheme" + Author: @Oldes + Rights: "Copyright (C) 2022 Oldes. All rights reserved." + License: MIT + History: [ + 1.0.0 20-Jul-2022 @Oldes "Initial version" + ] + Notes: { + https://www.nist.gov/pml/time-and-frequency-division/time-distribution/internet-time-service-its + } + Usage: [ + ;; for default time.nist.gov + read daytime:// + ;; or custom: + read daytime://utcnist.colorado.edu + ] +] + +system/options/log/daytime: 1 +daytime-sync-awake: func[event /local port type][ + port: event/port + type: event/type + sys/log/debug 'DAYTIME ["Sync-Awake event:" type] + switch type [ + lookup [ open port return false] + connect [ read port return false] + ] + true +] +parse-NIST: func[ + data [string!] + /local JJJJJ YR MO DA HH MM SS TT L H msADV numeric +][ + numeric: :system/catalog/bitsets/numeric + ;JJJJJ YR-MO-DA HH:MM:SS TT L H msADV UTC(NIST) OTM + all [ + parse data [ + any whitespace + copy JJJJJ: some numeric SP + ;; JJJJJ is the Modified Julian Date (MJD). + ;; The MJD has a starting point of midnight on November 17, 1858. You can obtain the MJD + ;; by subtracting exactly 2 400 000.5 days from the Julian Date, which is an integer day + ;; number obtained by counting days from the starting point of noon on 1 January 4713 B.C. + ;; (Julian Day zero). + copy YR: 2 numeric #"-" + copy MO: 2 numeric #"-" + copy DA: 2 numeric SP + ;; YR-MO-DA is the date. + ;; It shows the last two digits of the year, the month, and the current day of month. + copy HH: 2 numeric #":" + copy MM: 2 numeric #":" + copy SS: 2 numeric SP + ;; HH:MM:SS is the time in hours, minutes, and seconds. + ;; The time is always sent as Coordinated Universal Time (UTC). + copy TT: 2 numeric SP + ;; TT is a two digit code (00 to 99) that indicates whether the United States is on + ;; Standard Time (ST) or Daylight Saving Time (DST). It also indicates when ST or + ;; DST is approaching. This code is set to 00 when ST is in effect, or to 50 when DST + ;; is in effect. During the month in which the time change actually occurs, this number + ;; will decrement every day until the change occurs. For example, during the month of November, + ;; the U.S. changes from DST to ST. On November 1, the number will change from 50 to the actual + ;; number of days until the time change. It will decrement by 1 every day until the change + ;; occurs at 2 a.m. local time when the value is 1. Likewise, the spring change is at 2 a.m. + ;; local time when the value reaches 51. + copy L: 1 numeric SP + ;; L is a one-digit code that indicates whether a leap second will be added or subtracted + ;; at midnight on the last day of the current month. If the code is 0, no leap second will + ;; occur this month. If the code is 1, a positive leap second will be added at the end of + ;; the month. This means that the last minute of the month will contain 61 seconds + ;; instead of 60. If the code is 2, a second will be deleted on the last day of the month. + ;; Leap seconds occur at a rate of about one per year. They are used to correct for irregularity + ;; in the earth's rotation. The correction is made just before midnight UTC (not local time). + copy H: 1 numeric SP + ;; H is a health digit that indicates the health of the server. If H = 0, the server is healthy. + ;; If H = 1, then the server is operating properly but its time may be in error by up to 5 seconds. + ;; This state should change to fully healthy within 10 minutes. If H = 2, then the server is + ;; operating properly but its time is known to be wrong by more than 5 seconds. If H = 3, then + ;; a hardware or software failure has occurred and the amount of the time error is unknown. + ;; If H = 4 the system is operating in a special maintenance mode and both its accuracy and + ;; its response time may be degraded. This value is not used for production servers except in + ;; special circumstances. The transmitted time will still be correct to within ±1 second in this mode. + copy msADV: [some numeric #"." some numeric] SP + ;; msADV displays the number of milliseconds that NIST advances the time code to partially + ;; compensate for network delays. The advance is currently set to 50.0 milliseconds. + "UTC(NIST) *" to end + ;; The label UTC(NIST) is contained in every time code. It indicates that you are receiving + ;; Coordinated Universal Time (UTC) from the National Institute of Standards and Technology (NIST). + ;; OTM (on-time marker) is an asterisk (*). The time values sent by the time code refer to + ;; the arrival time of the OTM. In other words, if the time code says it is 12:45:45, + ;; this means it is 12:45:45 when the OTM arrives. + ] + reduce [ + to integer! JJJJJ + to date! ajoin [DA #"-" MO #"-" YR #"/" HH #":" MM #":" SS] + to integer! TT + to integer! L + to integer! H + to decimal! msADV + ] + ] +] + +sys/make-scheme [ + name: 'daytime + title: "Daytime Protocol (RFC 867)" + spec: make system/standard/port-spec-net [ + port: 13 + timeout: 15 + ] +; awake: func[event][ +; sys/log/info 'DAYTIME ["Awake event:" type] +; true +; ] + actor: [ + open: func [ + port [port!] + /local spec conn + ][ + if open? port [return port] + port/extra: open as url! ajoin [ + tcp:// + any [port/spec/host "time.nist.gov"] + #":" port/spec/port + ] + port/extra/awake: :daytime-sync-awake + port/extra + ] + open?: func [port][ + all [ + port? port/extra + open? port/extra + ] + ] + read: func[port][ + open port + wait [port/extra port/spec/timeout] + if binary? port/extra/data [ + port/data: trim/tail/head to string! port/extra/data + ] + sys/log/info 'DAYTIME ["Server:" port/data] + close port + all [ + port/data + parse-NIST port/data + ] + ] + close: func [port][ + if open? port [return port] + close port/extra + port/extra: none + port + ] + ] +] diff --git a/src/tests/units/port-test.r3 b/src/tests/units/port-test.r3 index f2f1b1d5af..259bd28c7d 100644 --- a/src/tests/units/port-test.r3 +++ b/src/tests/units/port-test.r3 @@ -538,6 +538,18 @@ if system/platform = 'Windows [ ===end-group=== +import 'daytime +if find system/schemes 'daytime [ +===start-group=== "DAYTIME scheme" + --test-- "read DAYTIME" + --assert all [ + block? res: try [read daytime://] + res/2/date = now/date + ] + +===end-group=== +] + if all [ "true" <> get-env "CONTINUOUS_INTEGRATION" "true" <> get-env "CI" ; for GitHub workflows