calendar: pure UTC epoch-ms <-> civil-date layer (chrono parity)
ober
5b23e86594ecae79057f0126e8d9e2341f3ebe9f
--- a/Makefile +++ b/Makefile @@ -8,7 +8,7 @@ SCHEME ?= $(JERBOA)/.chez/bin/scheme BUILD ?= build/rust TYPED := $(wildcard typed/*.ss) -.PHONY: rust test ffi-demo kernels-check triage-check triage-store-check analytics-check detect-check storage-check entity-check threats-check geoip-check sigma-check yaml-rules-check buffer-check dns-sniffer-check suspicious-check netconn-check kernmod-check selinux-check container-check dns-servers-check sensitive-path-check dtrace-parse-check proc-linux-check freebsd-parse-check event-meta-check config-check event-danger-check persistence-check file-change-check webshell-check platform-mounts-check analyze-cli-check collector-cli-check event-summary-check ioc-check frame-check correlate-check revshell-check cron-check logtamper-check detection-rules-check ipaddr-check auth-check lolbin-check dga-check checks clean +.PHONY: rust test ffi-demo kernels-check triage-check triage-store-check analytics-check detect-check storage-check entity-check threats-check geoip-check sigma-check yaml-rules-check buffer-check dns-sniffer-check suspicious-check netconn-check kernmod-check selinux-check container-check dns-servers-check sensitive-path-check dtrace-parse-check proc-linux-check freebsd-parse-check event-meta-check config-check event-danger-check persistence-check file-change-check webshell-check platform-mounts-check analyze-cli-check collector-cli-check event-summary-check ioc-check frame-check correlate-check revshell-check cron-check logtamper-check detection-rules-check ipaddr-check auth-check lolbin-check dga-check calendar-check checks clean # Combined libdir path so sibling libraries `(jsecmon ...)` resolve to ./jsecmon # (a second --libdirs would replace, not append, the jerboa one). LIBDIRS := "$(JERBOA)/lib:$(CURDIR)" @@ -323,6 +323,12 @@ ipaddr-check: auth-check: $(SCHEME) --libdirs $(LIBDIRS) --script examples/auth_check.ss +# calendar.ss: pure UTC epoch-ms <-> civil-date (Hinnant), matching chrono's +# format_ts / format_ts_iso / parse_hour_to_ms / parse_datetime + the +# test_parse_datetime invariants. No native lib, no clock except now-ms. +calendar-check: + $(SCHEME) --libdirs $(LIBDIRS) --script examples/calendar_check.ss + # Everything that runs through the Jerboa side of the bridge, one shot. checks: kernels-check $(SCHEME) --libdirs $(LIBDIRS) --script examples/triage_check.ss @@ -368,6 +374,7 @@ checks: kernels-check $(SCHEME) --libdirs $(LIBDIRS) --script examples/auth_check.ss $(SCHEME) --libdirs $(LIBDIRS) --script examples/lolbin_check.ss $(SCHEME) --libdirs $(LIBDIRS) --script examples/dga_check.ss + $(SCHEME) --libdirs $(LIBDIRS) --script examples/calendar_check.ss clean: rm -rf $(BUILD) --- a/README.md +++ b/README.md @@ -149,7 +149,7 @@ then crypto orchestration, then I/O / async / FFI (monitors, server, storage). | `monitor/files` (`FileIntegrityMonitor::is_suspicious_change`) | `jsecmon/file-change.ss` | ✅ **untyped layer** — the deciding logic with stat/hashing stripped (modes + change-type + platform passed in): ordered first-match — setuid then setgid bit *added* (both modes known), exact platform critical file, `authorized_keys`/`cron` substrings, then a platform sensitive dir on `created` only. Pins the order corner that the `cron` substring precedes the sensitive-dir step, so a created `/etc/cron.d/x` reports "Cron configuration modified", never the sensitive-dir message; the critical-files/sensitive-dirs sets switch on `cfg!(target_os)` (linux/freebsd/other). Pure — the `stat`/SHA-256 baseline is the deferred I/O — no native lib; secmon has no `#[test]` here so `make file-change-check` asserts against the Rust source. | | `monitor/webshell` (`WebshellMonitor` classifiers) | `jsecmon/webshell.ss` | ✅ **untyped layer** — the three pure deciders with the `/proc` scan + parent/child PID walk + event emission stripped: `is_web_server` (lower-cased name **substring** vs the server list, so `php-fpm` matches `php`), `is_suspicious_child` (process name by **exact** lower-cased equality — `bashx` is clean — OR the joined+lowercased cmdline **substring**-matched against the pattern list), and `get_detection_reason` (scans only the cmdline patterns, **in list order**, first match → `Suspicious command pattern: {pat}`, else the default `Web server spawned suspicious process: {name}` with the **original-case** name). obfstr!-hidden lists decode to these plaintext literals. Pins the corner that the reason is chosen by pattern-list order, not cmdline-token order, and that a name-only hit yields the default reason. Pure — the PID walk is the deferred monitor loop — no native lib; secmon has no `#[test]` here so `make webshell-check` asserts against the Rust source. | | `monitor::dns_sniffer` (DNS wire parser + dedup) | `jsecmon/dns-sniffer.ss` | ✅ **untyped layer** — the platform-independent half of secmon's `src/monitor/dns_sniffer.rs`: the DNS wire-format parser (QNAME decoding with compression-pointer chasing capped at 128 steps, QTYPE→string, question + A/AAAA answer-RR extraction), the `parse_ip_udp_dns` IPv4+UDP header peel (version/IHL/protocol checks, port-53 server/response classification → DNS payload), and the 5s dedup / 30s cleanup state machine. Every bounds check is preserved — a truncated/malformed/looping packet yields `#f`, never a bad read. Pure byte parsing → untyped, like geoip. Only the AF_PACKET raw-socket capture + `/proc` PID lookup stay for the monitor I/O driver. `make dns-sniffer-check` reproduces secmon's parser + dedup tests (+ AAAA, qtype table, pointer-loop/qdcount guards, and the IP/UDP peel with version/protocol/port negatives). | -| `bin/analyze` (CLI parse helpers) | `jsecmon/analyze-cli.ss` | ✅ **untyped layer** — the pure argument parsers of the `analyze` binary, returning the prelude Result (ok/err) to mirror Rust's `Result<_, String>` **including the exact error text**: `parse_duration_ms` (`10m`/`2h`/`1d`/bare-seconds → ms; splits leading ASCII digits from the unit; empty → `empty duration`, bad number/leading-non-digit → `invalid duration: {s}`, bad unit like `m5` → `unknown duration unit: …`; the number must fit i64) and `AlertSink::parse` (`stdout` / `file:PATH` / `webhook:URL` / `syslog` / `syslog:TAG`, first-match in order, remainder taken verbatim so `file:` → empty path) and `parse_alert_sinks` (collect every `--alert-to <spec>`, parsing each and short-circuiting on the first bad spec like Rust's `?`; a trailing `--alert-to` with no value is skipped, and no flags → the empty list — the watch-time default-to-stdout lives in `cmd_watch`), plus the generic `--flag` scanners shared across the CLI (`parse_flag_value` → the arg after the **first** `flag`, or `#f` even when the flag is last; `has_flag` → membership; `is_json_format` → the first `--format` that has a value decides, a trailing `--format` is skipped). Pure string→Result/bool; the sink dispatch (stdout/file append/curl webhook/`logger` syslog) and query dispatch are the deferred I/O. secmon has no `#[test]` here so `make analyze-cli-check` asserts against the Rust source. (`format_ts`/`format_ts_iso` are chrono-calendar-coupled display helpers — deferred with the other calendar I/O.) | +| `bin/analyze` (CLI parse helpers) | `jsecmon/analyze-cli.ss` | ✅ **untyped layer** — the pure argument parsers of the `analyze` binary, returning the prelude Result (ok/err) to mirror Rust's `Result<_, String>` **including the exact error text**: `parse_duration_ms` (`10m`/`2h`/`1d`/bare-seconds → ms; splits leading ASCII digits from the unit; empty → `empty duration`, bad number/leading-non-digit → `invalid duration: {s}`, bad unit like `m5` → `unknown duration unit: …`; the number must fit i64) and `AlertSink::parse` (`stdout` / `file:PATH` / `webhook:URL` / `syslog` / `syslog:TAG`, first-match in order, remainder taken verbatim so `file:` → empty path) and `parse_alert_sinks` (collect every `--alert-to <spec>`, parsing each and short-circuiting on the first bad spec like Rust's `?`; a trailing `--alert-to` with no value is skipped, and no flags → the empty list — the watch-time default-to-stdout lives in `cmd_watch`), plus the generic `--flag` scanners shared across the CLI (`parse_flag_value` → the arg after the **first** `flag`, or `#f` even when the flag is last; `has_flag` → membership; `is_json_format` → the first `--format` that has a value decides, a trailing `--format` is skipped). Pure string→Result/bool; the sink dispatch (stdout/file append/curl webhook/`logger` syslog) and query dispatch are the deferred I/O. secmon has no `#[test]` here so `make analyze-cli-check` asserts against the Rust source. (`format_ts`/`format_ts_iso` display helpers now live in `jsecmon/calendar.ss`; only the actual stdout/file/webhook/syslog emission stays deferred.) | | `bin/collector` (CLI/hosts parse helpers) | `jsecmon/collector-cli.ss` | ✅ **untyped layer** — the pure argument/hosts parsing of the `collector` binary, with the async polling + ECIES/PSK key loading + SQLite I/O deferred: `parse_after_seq` (first `--after` value as u64, `unwrap_or(0)` so junk/negative/≥2⁶⁴ → 0), `parse_format` (→ `'json`/`'human`/`'quiet`; a per-index scan where an unknown `--format` value does **not** consume the value — differs from analyze's `is_json_format` — and the no-flag default is `quiet` when a `--db` is present else `human`), `parse_db_path`, `normalize_host` (append `:31337` unless the host already contains **any** `:`, so bare IPv6 is left as-is, faithfully), `collect_positional_hosts` (skip the four value flags **and** their values, drop other `--` args, normalize the rest), and `parse_hosts_file`'s pure contents→hosts core (trim, drop blanks/`#` comments, normalize). secmon has no `#[test]` here so `make collector-cli-check` asserts against the Rust source. | | `storage` event readers (`extract_pid` / `extract_process_name` / `build_summary`) | `jsecmon/event-summary.ss` | ✅ **untyped layer** — the pure readers that turn an event's flat JSON `data` (a hash table, as `string->json-object` yields) back into a pid / process name / one-line summary, with the SQLite query + serde plumbing left to storage. Each field is read through a **typed** getter so only a JSON value of the right type counts (`as_u64`/`as_i64`/`as_str`/`as_bool`); `extract_pid` walks pid→source_pid→spawned_pid→web_server_pid and truncates the first hit to **u32** (Rust `v as u32`, so ≥2³² wraps, and pid 0 is a real hit); `extract_process_name` walks process_name→name→exe→source_process→spawned_process. `build_summary` reproduces every per-type format with the exact `unwrap_or` defaults (`"?"`/`0`), the `process_exit` exit-code *option* (Some(0) still prints `(0)`), the nested `selinux_event` perm/class/path-vs-message branches with the 80-char message cap, and the catch-all that scans values **in sorted key order** (serde's default BTreeMap) for the first string longer than 3 chars (capped at 80) else the event type. `make event-summary-check` (43 cases) reproduces secmon's `test_extract_helpers` + `test_build_summary` and adds every per-type / typed-getter corner derived from the source. | | `storage` IOC parsing (`detect_ioc_type` / `is_ipv4` / `parse_ioc_text`) | `jsecmon/ioc.ss` | ✅ **untyped layer** — the pure indicator classifier behind threat-list ingestion (the file read in `load_ioc_file` is the deferred I/O). `detect_ioc_type` is first-match ip→hash→domain→process: `is_ipv4` (split on `.`, exactly 4 non-empty ≤3-char all-digit groups — **no** 0–255 range check, so `999.999.999.999` is still Ip and `1.2.3.4444` is not), then IPv6 (`:` present and every char hex-or-`:`), then a 32/40/64-length all-hex Hash (MD5/SHA1/SHA256, case-insensitive), then a `.`-bearing space-free Domain, else Process. `parse_ioc_text` trims, drops blanks and `#` comments, and tags each remaining line (order preserved). `ioc_type_json_fields` / `ioc_type_column_fields` expose the per-type JSON-path and column lists `match_iocs` probes (pure routing data; Process is the only type with a plain column, `process_name`). `make ioc-check` reproduces the `test_ioc_type_detection` #[test] plus the is_ipv4 / parse / field-routing corners. | @@ -159,4 +159,5 @@ then crypto orchestration, then I/O / async / FFI (monitors, server, storage). | `storage` detection-rule ATT&CK catalog (`DETECTION_RULES` / `rule_attack` / `anomaly_rule_attack`) | `jsecmon/detection-rules.ss` | ✅ **untyped layer** — the static `DETECTION_RULES` table (13 rows: name / description / severity / MITRE techniques) and its pure lookups, used to annotate findings with ATT&CK IDs and to list/validate rule names (the SQL detectors that fire these live in `(jsecmon threats)`). `rule-attack` finds the row by exact name and returns its `attack` list, else `()` (unwrap_or_default); `rule-names` / `rule-known?` mirror the listing/validation paths. `anomaly-rule-attack` is the separate match for the `detect_anomalies` **statistical** rules (not in the table): `kill_chain` → recon/lateral/exfil tactics, `off_hours` → Defense Evasion, others (frequency_spike, severity_cluster) → `()`. const has no #[test], so `make detection-rules-check` asserts every row + both lookups and **is** the spec. | | `monitor/lateral` IP parsing + internal-network test (`is_internal_ip`) | `jsecmon/ipaddr.ss` | ✅ **untyped layer** — `is_internal_ip` parses `ip_str.parse::<IpAddr>()` first and only classifies on success, so `parse-ipv4` / `parse-ipv6` faithfully reproduce **Rust std's `IpAddr` FromStr** boundary: IPv4 = exactly 4 octets, 1–3 digits, **no leading zeros**, ≤255; IPv6 = colon-separated 1–4-digit hex groups with at most one `::` (eliding ≥1 zero group) and an optional trailing embedded IPv4 (forbidden before `::`). `is-internal-ip` then mirrors lateral.rs: V4 `10/8` · `172.16/12` · `192.168/16` · `127/8`, V6 `fc00::/7` (`seg0 & 0xfe00 == 0xfc00`) or loopback. lateral.rs has no #[test]; expectations were generated by a **std-only Rust oracle** over ~70 inputs, so `make ipaddr-check` (88 cases) pins the port to real Rust and **is** the spec. | | `monitor/auth` log-line parsers (`parse_auth_line` + 7 sub-parsers) | `jsecmon/auth.ss` | ✅ **untyped layer** — the dispatcher lowercases and routes on substrings (`sshd`→ssh, `sudo`, `su[`/`su:`, `authentication failure`→pam, `useradd`/`adduser`, `userdel`/`deluser`, `password changed`/`passwd`), each sub-parser pulling fields with `extract_field(line, start, end)`. Faithful corners: `extract_field` searches the **raw** line (case-sensitive) while dispatch/success use the lower-cased copy, so `Invalid user admin` → username `unknown`; the SSH "accepted" branch `?`-propagates a missing `for ` to **#f** (no fall-through); and the documented quirks where the username captures `TTY=pts/0` / `authentication failure; TTY=…` / `root)` are preserved. AuthEventType → `'ssh-key-auth 'login 'failed-login 'sudo-attempt 'su-attempt 'user-created 'user-deleted 'password-change`; None → `#f`. auth.rs has no #[test]; `make auth-check` (24 cases) derives every expectation from a **std-only Rust oracle** over the verbatim bodies and **is** the spec. | +| `format_ts` / `format_ts_iso` / `parse_hour_to_ms` / `parse_datetime` (chrono UTC calendar) | `jsecmon/calendar.ss` | ✅ **untyped layer** — the pure epoch-ms ↔ civil-date boundary the detect/analytics seeds defer to. secmon formats/parses timestamps with chrono always in UTC (`DateTime::from_timestamp_millis`, `NaiveDateTime`), which is pure proleptic-Gregorian arithmetic, reproduced exactly with Howard Hinnant's `days_from_civil`/`civil_from_days`: `format-ts` (`%Y-%m-%d %H:%M:%S`, storage+analyze), `format-ts-iso` (`%Y-%m-%dT%H:%M:%S%.3fZ`, analyze), `parse-hour-to-ms` (`%Y-%m-%d %H`+`:00:00`, the frequency-spike inverse of `%H` decomposition, bad input → 0), and `parse-datetime-ms` (returns the prelude Result: relative `Nh`/`Nd` from an optional `at`/now, then RFC3339 with `Z`/`±HH:MM` offset and optional `.fff`, then naive ISO assumed-UTC, then date-only; else `err` with the exact Rust message). Faithful corners: Hinnant's `/` truncates toward zero (`quotient`) but the ms→day split must **floor** (a pre-1970 ms keeps a non-negative ms-of-day), so the parts use exact `floor`; the export is `parse-datetime-ms`/`char-index` to avoid shadowing the prelude's own `parse-datetime` (a datetime record) and `string-index`. `make calendar-check` pins the civil round-trip, both formatters (incl. leap-day, negative-ms flooring), `parse_hour_to_ms`, and secmon's `test_parse_datetime` invariants (28 cases). | | monitors / server / ebpf / dtrace | — | ⏳ I/O+async+FFI, last | new file mode 100644 --- /dev/null +++ b/examples/calendar_check.ss @@ -0,0 +1,72 @@ +;;; Parity check for (jsecmon calendar) against secmon's chrono-based UTC +;;; timestamp formatting/parsing (format_ts, format_ts_iso, parse_hour_to_ms, +;;; parse_datetime) and the test_parse_datetime #[test]. Reference epoch-ms +;;; values cross-checked against Python's datetime (UTC). +;;; +;;; scheme --libdirs "$JERBOA/lib:." --script examples/calendar_check.ss + +(import (jerboa prelude) + (jsecmon calendar)) + +(def fails 0) +(def (check name got want) + (let ((ok (equal? got want))) + (unless ok (set! fails (+ fails 1))) + (displayln (if ok " ok " " FAIL ") name + (if ok "" (str " got " got " want " want))))) + +;; ── civil round-trip (Hinnant) ─────────────────────────────────────────────── +(displayln "civil arithmetic:") +(check "epoch day 0 = 1970-01-01" (civil-from-days 0) '(1970 1 1)) +(check "1970-01-01 = day 0" (days-from-civil 1970 1 1) 0) +(check "leap 2000-02-29 round-trip" + (civil-from-days (days-from-civil 2000 2 29)) '(2000 2 29)) +(check "pre-epoch 1969-12-31" (civil-from-days -1) '(1969 12 31)) + +;; ── format-ts : chrono "%Y-%m-%d %H:%M:%S" ──────────────────────────────────── +(displayln "format-ts:") +(check "epoch 0" (format-ts 0) "1970-01-01 00:00:00") +(check "2024-01-15" (format-ts 1705276800000) "2024-01-15 00:00:00") +(check "2024-01-15 10:30" (format-ts 1705314600000) "2024-01-15 10:30:00") +(check "leap day noon" (format-ts 951825600000) "2000-02-29 12:00:00") +(check "neg -1000" (format-ts -1000) "1969-12-31 23:59:59") +(check "neg -1 floors tod" (format-ts -1) "1969-12-31 23:59:59") + +;; ── format-ts-iso : chrono "%Y-%m-%dT%H:%M:%S%.3fZ" ─────────────────────────── +(displayln "format-ts-iso:") +(check "epoch 0 iso" (format-ts-iso 0) "1970-01-01T00:00:00.000Z") +(check "millis .123" (format-ts-iso 1705314600123) "2024-01-15T10:30:00.123Z") +(check "neg -1 iso .999" (format-ts-iso -1) "1969-12-31T23:59:59.999Z") + +;; ── parse-hour-to-ms : "%Y-%m-%d %H" + ":00:00", else 0 ─────────────────────── +(displayln "parse-hour-to-ms:") +(check "valid hour" (parse-hour-to-ms "2024-01-15 10") 1705312800000) +(check "midnight" (parse-hour-to-ms "2024-01-15 00") 1705276800000) +(check "garbage -> 0" (parse-hour-to-ms "not-a-date") 0) +(check "hour 25 -> 0" (parse-hour-to-ms "2024-01-15 25") 0) + +;; ── parse-datetime-ms: relative | RFC3339 | naive ISO | date-only ─────────────── +(displayln "parse-datetime:") +(check "date only" (unwrap (parse-datetime-ms "2024-01-15")) 1705276800000) +(check "iso Z" (unwrap (parse-datetime-ms "2024-01-15T10:30:00Z")) 1705314600000) +(check "iso no tz=UTC" (unwrap (parse-datetime-ms "2024-01-15T10:30:00")) 1705314600000) +(check "iso millis" (unwrap (parse-datetime-ms "2024-01-15T10:30:00.500Z")) 1705314600500) +(check "iso +02:00" (unwrap (parse-datetime-ms "2024-01-15T10:30:00+02:00")) 1705307400000) +;; relative is measured from an explicit `at` so the test is deterministic +(check "relative 24h" (unwrap (parse-datetime-ms "24h" 1000000000000)) (- 1000000000000 (* 24 3600 1000))) +(check "relative 7d" (unwrap (parse-datetime-ms "7d" 1000000000000)) (- 1000000000000 (* 7 86400 1000))) +(check "bad input errs" (err? (parse-datetime-ms "definitely not a date")) #t) +;; secmon test_parse_datetime invariants +(check "iso > date-only" + (> (unwrap (parse-datetime-ms "2024-01-15T10:30:00Z")) (unwrap (parse-datetime-ms "2024-01-15"))) #t) +(check "24h from now < now" + (< (unwrap (parse-datetime-ms "24h")) (now-ms)) #t) + +;; ── the deferred-seed boundary: a raw *-ms field formats like secmon ────────── +(check "format-ts ∘ parse-datetime-ms round-trip" + (format-ts (unwrap (parse-datetime-ms "2024-01-15T10:30:00Z"))) "2024-01-15 10:30:00") + +(newline) +(if (= fails 0) + (displayln "OK: calendar matches chrono's UTC format/parse + test_parse_datetime.") + (begin (displayln fails " FAILURES") (exit 1))) new file mode 100644 --- /dev/null +++ b/jsecmon/calendar.ss @@ -0,0 +1,218 @@ +#!chezscheme +;;; jsecmon calendar — the pure UTC epoch-ms ↔ civil-date layer. +;;; +;;; secmon formats and parses timestamps with chrono, always in UTC +;;; (DateTime::from_timestamp_millis / NaiveDateTime). chrono's UTC conversion +;;; is pure proleptic-Gregorian arithmetic, so we reproduce it exactly with +;;; Howard Hinnant's days_from_civil / civil_from_days (no timezone, no locale, +;;; no dependency on the host clock except where secmon itself reads the clock). +;;; This is the calendar boundary the detect_* anomaly seeds defer to: a seed +;;; carries raw *-ms fields and the caller runs them through `format-ts`. +;;; +;;; format-ts chrono "%Y-%m-%d %H:%M:%S" (storage + analyze) +;;; format-ts-iso chrono "%Y-%m-%dT%H:%M:%S%.3fZ" (analyze) +;;; parse-hour-to-ms "%Y-%m-%d %H" + ":00:00" (frequency-spikes) +;;; parse-datetime-ms relative Nh/Nd | RFC3339 | ISO | date-only +;;; +;;; Hinnant's divisions truncate toward zero (C++ `/`), so they use `quotient`; +;;; the ms→day split must floor (a pre-1970 ms keeps a non-negative ms-of-day), +;;; so it uses exact `floor`. Verified against chrono/Python in examples. + +(library (jsecmon calendar) + (export days-from-civil civil-from-days + format-ts format-ts-iso parse-hour-to-ms parse-datetime-ms + now-ms) + (import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?)) + + (def ms/day 86400000) + + ;; Days since 1970-01-01 for a proleptic-Gregorian (y,m,d). Hinnant's algorithm; + ;; `quotient` truncates toward zero exactly like the C++ `/` it assumes. + (def (days-from-civil y m d) + (let* ((y2 (if (<= m 2) (- y 1) y)) + (era (quotient (if (>= y2 0) y2 (- y2 399)) 400)) + (yoe (- y2 (* era 400))) + (doy (+ (quotient (+ (* 153 (+ m (if (> m 2) -3 9))) 2) 5) (- d 1))) + (doe (+ (* yoe 365) (quotient yoe 4) (- (quotient yoe 100)) doy))) + (+ (* era 146097) doe -719468))) + + ;; Inverse: (y m d) for a day count since 1970-01-01. Hinnant's algorithm. + (def (civil-from-days z0) + (let* ((z (+ z0 719468)) + (era (quotient (if (>= z 0) z (- z 146096)) 146097)) + (doe (- z (* era 146097))) + (yoe (quotient (+ (- doe (quotient doe 1460)) (quotient doe 36524) + (- (quotient doe 146096))) + 365)) + (y (+ yoe (* era 400))) + (doy (- doe (+ (* 365 yoe) (quotient yoe 4) (- (quotient yoe 100))))) + (mp (quotient (+ (* 5 doy) 2) 153)) + (d (+ (- doy (quotient (+ (* 153 mp) 2) 5)) 1)) + (m (+ mp (if (< mp 10) 3 -9)))) + (list (if (<= m 2) (+ y 1) y) m d))) + + ;; zero-pad |n| to at least `width` digits (years over 9999 keep extra digits). + (def (pad n width) + (let ((s (number->string (abs n)))) + (string-append (make-string (max 0 (- width (string-length s))) #\0) s))) + + ;; split an epoch-ms into (y m d hour minute second millis), UTC. The day split + ;; floors so the time-of-day stays in [0, ms/day) even for negative ms. + (def (ms->parts ms) + (let* ((days (floor (/ ms ms/day))) + (tod (- ms (* days ms/day))) + (ymd (civil-from-days days)) + (secs (quotient tod 1000))) + (list (car ymd) (cadr ymd) (caddr ymd) + (quotient secs 3600) + (quotient (remainder secs 3600) 60) + (remainder secs 60) + (remainder tod 1000)))) + + ;; chrono "%Y-%m-%d %H:%M:%S" (UTC). + (def (format-ts ms) + (let ((p (ms->parts ms))) + (str (pad (list-ref p 0) 4) "-" (pad (list-ref p 1) 2) "-" (pad (list-ref p 2) 2) + " " (pad (list-ref p 3) 2) ":" (pad (list-ref p 4) 2) ":" (pad (list-ref p 5) 2)))) + + ;; chrono "%Y-%m-%dT%H:%M:%S%.3fZ" (UTC, milliseconds). + (def (format-ts-iso ms) + (let ((p (ms->parts ms))) + (str (pad (list-ref p 0) 4) "-" (pad (list-ref p 1) 2) "-" (pad (list-ref p 2) 2) + "T" (pad (list-ref p 3) 2) ":" (pad (list-ref p 4) 2) ":" (pad (list-ref p 5) 2) + "." (pad (list-ref p 6) 3) "Z"))) + + (def (ascii-digit? c) (and (char>=? c #\0) (char<=? c #\9))) + (def (all-ascii-digits? s) (for/and ((c (in-string s))) (ascii-digit? c))) + + ;; string → exact integer, or #f (mirrors Rust parse::<i64>: no float, no junk). + (def (str->int s) + (let ((v (string->number s))) + (and v (integer? v) (exact? v) v))) + + ;; #f unless s is exactly `digits` ASCII digits; else its integer value. + (def (digits->int s digits) + (and (= (string-length s) digits) + (all-ascii-digits? s) + (string->number s))) + + ;; parse "YYYY-MM-DD" into (y m d) or #f. + (def (parse-ymd s) + (let ((ps (string-split s #\-))) + (and (= (length ps) 3) + (let ((y (digits->int (car ps) 4)) + (m (digits->int (cadr ps) 2)) + (d (digits->int (caddr ps) 2))) + (and y m d (list y m d)))))) + + ;; epoch-ms for a (y m d) at 00:00:00 UTC. + (def (ymd->ms y m d) (* (days-from-civil y m d) ms/day)) + + ;; secmon parse_hour_to_ms: "YYYY-MM-DD HH" + ":00:00" parsed as UTC, else 0. + (def (parse-hour-to-ms hour) + (let ((ps (string-split hour #\space))) + (or (and (= (length ps) 2) + (let ((ymd (parse-ymd (car ps))) (h (digits->int (cadr ps) 2))) + (and ymd h (>= h 0) (<= h 23) + (+ (ymd->ms (car ymd) (cadr ymd) (caddr ymd)) (* h 3600000))))) + 0))) + + ;; parse "HH:MM:SS" into seconds-of-day, or #f. + (def (parse-hms s) + (let ((ps (string-split s #\:))) + (and (= (length ps) 3) + (let ((h (digits->int (car ps) 2)) + (mi (digits->int (cadr ps) 2)) + (se (digits->int (caddr ps) 2))) + (and h mi se (+ (* h 3600) (* mi 60) se)))))) + + ;; epoch-ms now (UTC), matching chrono::Utc::now().timestamp_millis(). + (def (now-ms) + (let ((t (current-time 'time-utc))) + (+ (* (time-second t) 1000) (quotient (time-nanosecond t) 1000000)))) + + ;; parse an ISO datetime body "YYYY-MM-DDTHH:MM:SS" with optional ".fff" + ;; fraction and optional tz ("Z" or "±HH:MM"), returning UTC ms or #f. chrono's + ;; parse_from_rfc3339 (tz present) and the naive %Y-%m-%dT%H:%M:%S(Z) forms. + (def (parse-iso s) + (let ((parts (string-split s #\T))) + (and (= (length parts) 2) + (let ((ymd (parse-ymd (car parts)))) + (and ymd + (let* ((rest (cadr parts)) + ;; peel a trailing tz: Z (UTC) or ±HH:MM (offset minutes) + (off+body (split-tz rest)) + (off-min (car off+body)) + (body (cdr off+body)) + ;; peel optional .fff fraction → millis + (dot (char-index body #\.)) + (hms-str (if dot (substring body 0 dot) body)) + (millis (if dot (frac->millis (substring body (+ dot 1) (string-length body))) 0)) + (sod (and hms-str (parse-hms hms-str)))) + (and sod off-min millis + (- (+ (ymd->ms (car ymd) (cadr ymd) (caddr ymd)) + (* sod 1000) millis) + (* off-min 60000))))))))) + + ;; index of char c in s, or #f. + (def (char-index s c) + (let loop ((i 0)) + (cond ((>= i (string-length s)) #f) + ((char=? (string-ref s i) c) i) + (else (loop (+ i 1)))))) + + ;; ".fff…" fraction string (sans dot) → milliseconds (first 3 digits, padded). + (def (frac->millis f) + (and (> (string-length f) 0) + (all-ascii-digits? f) + (let ((f3 (if (>= (string-length f) 3) + (substring f 0 3) + (string-append f (make-string (- 3 (string-length f)) #\0))))) + (string->number f3)))) + + ;; peel a trailing timezone from an ISO time body. Returns (offset-min . body): + ;; offset-min is the signed minutes EAST of UTC (so UTC = local − offset), body + ;; is the time without the tz. No tz → offset 0 (naive, assume UTC, like secmon). + (def (split-tz s) + (let ((n (string-length s))) + (cond + ((and (> n 0) (char=? (string-ref s (- n 1)) #\Z)) + (cons 0 (substring s 0 (- n 1)))) + ;; ±HH:MM at the tail (positions n-6..n-1, sign at n-6) + ((and (>= n 6) + (let ((sign (string-ref s (- n 6)))) + (or (char=? sign #\+) (char=? sign #\-))) + (char=? (string-ref s (- n 3)) #\:)) + (let* ((sign (string-ref s (- n 6))) + (hh (digits->int (substring s (- n 5) (- n 3)) 2)) + (mm (digits->int (substring s (- n 2) n) 2))) + (if (and hh mm) + (cons (* (if (char=? sign #\-) -1 1) (+ (* hh 60) mm)) + (substring s 0 (- n 6))) + (cons 0 s)))) + (else (cons 0 s))))) + + ;; secmon parse_datetime: relative Nh/Nd (from `at`, default now), then RFC3339, + ;; then naive ISO, then date-only — all UTC. Returns (ok ms) or (err message). + (def (parse-datetime-ms s (at (now-ms))) + (let ((n (string-length s))) + (cond + ((and (> n 1) (char=? (string-ref s (- n 1)) #\h) + (str->int (substring s 0 (- n 1)))) + => (lambda (hrs) (ok (- at (* hrs 3600 1000))))) + ((and (> n 1) (char=? (string-ref s (- n 1)) #\d) + (str->int (substring s 0 (- n 1)))) + => (lambda (days) (ok (- at (* days 86400 1000))))) + ((parse-iso s) => (lambda (ms) (ok ms))) + ((parse-ymd s) => (lambda (ymd) (ok (ymd->ms (car ymd) (cadr ymd) (caddr ymd))))) + (else (err (str "cannot parse datetime: '" s + "' (expected ISO 8601, date, or relative like '24h', '7d')")))))))