(load "vlans.glotawk")
(load "pf.glotawk")
(load "netflow_collect.glotawk")
(load "he-ddns.glotawk")
(load "he-6in4.glotawk")
(load "hardware.glotawk")
(load "carp.glotawk")
(load "dnsmasq.glotawk")
(load "dhcp-client.glotawk")
(load "firewall.glotawk")
(defun zuko-go ()
  (use-this-host)
  (firewall-jail (host-v6-subnet) "6"))
(save-lisp-and-die "../lacrum" "zuko-lacrum" 'zuko-go)

        (list :dmz    68 "dmz"     t  "0008"   68 t  t    t  2   t  t)
        (list :guest  71 "guest"   t  "0002"   71 t  t    f nil  t  t)

        (list :dmz    68 "dmz"     t  "8"      68 t  t    t  2   t  t)
        (list :guest  71 "guest"   t  "2"      71 t  t    f nil  t  t)

        (list :inside 73 "inside"  t  "0009"   73 t  t    f nil  t  t)
        (list :local  76 "local"   t  "004c"   76 t  t    f nil  t  t)

        (list :inside 73 "inside"  t  "9"      73 t  t    f nil  t  t)
        (list :local  76 "local"   t  "4c"     76 t  t    f nil  t  t)

(defun mapc-table (kwthunk table)
  (let ((titles (car table))
        (rows   (cdr table)))
    (dolist (row rows)
      (let ((alis (zip titles row)))
        (apply kwthunk alis)))))
(macro table-kw-lambda
  (lambda (args)
    `(lambda (:kw ,@(mapcar keyword-symbol (car (eval (car args)))))
       ,@(cdr args))))

(macro do-table
  (lambda (args)
    `(mapc-table (table-kw-lambda ,(car args) ,@(cdr args))
                 ,(car args))))

(defun mapc-ifcs-and-vlans (fun vlans networking)
  (let ((ifcs (cadr (assoc :ethernet-interfaces networking))))
    (dolist (ifc ifcs)
      (let ((mtu (assoc-path (list :mtus ifc) networking))
            (ifc-on-vlan (cadr (assoc :interface-on-vlan networking))))
        (dolist (alis (table-to-alists vlans))
          (let ((vid (cadr (assoc :vid alis))))
          (when (ifc-on-vlan ifc vid)
            (apply fun
                   (append `((:ifc ifc)
                             (:mtu mtu)
                             (:vif (sprintf "%s.%d" ifc vid))
                             (:v_if (sprintf "%s_%d" ifc vid)))
                           alis)))))))))

;; this macro runs over all the physical interfaces, and all the vlans
;; each interface uses, described by the list of all vlans above, and
;; the networking arrangement described by e.g. chromebox-networking.
;; e.g.

;; example:

;; (do-ifs-and-vlans chromebox-networking
;;    (have-fun-with if vid carpp))

;; (do-ifcs-and-vlans ((kw vid name) vlans chromebox-networking)
;;   (print kw))

;; that is to say, quite unhygienically, inside the body of this
;; macro, the current interface is bound to the symbol ~if~, also its
;; ~mtu~, and all the keywords from the first row of the vlan table
;; are bound as symbols, e.g. name, vid, fib, etc. also, quite
;; FreeBSD-ically, the interface name dot the vid is available as vif.
(macro do-ifs-and-vlans

;; names you provide (e.g. kw, vid, name) must be symbols that match
;; keywords (e.g. :kw, :vid, :name) in the header of vlans.
(macro do-ifcs-and-vlans

    `(let* ((networking ,(car args))
            (ifs (cadr (assoc :ethernet-interfaces networking))))
       (dolist (if ifs)
         (let ((mtu (assoc-path (list :mtus if) networking))
               (if-on-vlan (cadr (assoc :interface-on-vlan networking))))
           (do-table vlans
             (when (if-on-vlan if vid)
               (let ((vif (sprintf "%s.%d" if vid)))
                 ,@(cdr args)))))))))

    `(mapc-ifcs-and-vlans
      (lambda (:kw ,@(caar args)) ,@(cdr args))
      ,(cadar args)
      ,(car (cddar args)))))

(defun vlan-ula-host (vlan-kw octet)
  (let ((ans nil))
    (do-table ((kw v6s) vlans)
      (when (eq vlan-kw kw)
        (setq ans (sprintf "%s:%s::%s" ula-ipv6-48 v6s octet))))
    ans))

(defun vlan-ula-host (vlan-kw octet)
  (let ((vlan (assoc vlan-kw vlan-rows)))
    (eval `(multilet (,vlan-columns vlan)
             (sprintf "%s:%s::%s" ula-ipv6-48 v6sub octet)))))

    (do-ifs-and-vlans chromebox-networking

    (do-ifcs-and-vlans ((fwp vif) vlans chromebox-networking)

      (error "pf.conf.m4 leads to a pf.conf with a syntax error")))))

      (error "pf.conf.tmpl leads to a pf.conf with a syntax error")))))

(defun firewall-jail-netflow-collect-ngctl-script (ksocket-connect-string)

(defun firewall-jail-netflow-collect-ngctl-words (ksocket-connect-string)

        (first-if true)

        (first-ifc true)

    (do-ifs-and-vlans chromebox-networking
     (when fwp
       (push (sprintf "%s_%d" if number) ifs-to-collect)))

    (do-ifcs-and-vlans ((fwp v_if) vlans chromebox-networking)
      (when fwp (push v_if ifs-to-collect)))

    (dolist (ifc ifs-to-collect)
      (cond
       (first-if
        (push (sprintf "mkpeer %s: netflow lower iface%d" ifc nf-port) ngc)
        (push (sprintf "name %s:lower netflow" ifc) ngc)
        (push (sprintf "connect %s: netflow: upper out%d" ifc nf-port) ngc)
        (setq first-if false))
      (true
       (push (sprintf "connect %s: netflow: lower iface%d" ifc nf-port) ngc)
       (push (sprintf "connect %s: netflow: upper out%d"   ifc nf-port) ngc)))
      ;; 7 = INGRESS | EGRESS | ONCE; log both incoming and outgoing packets.
      (push (sprintf "msg netflow: setconfig {iface=%d conf=7}" nf-port) ngc)
      (setq nf-port (+ 1 nf-port)))
    (push "mkpeer netflow: ksocket export9 inet/dgram/udp" ngc)
    ;; export9 port: use NetFlow V9, which supports IPv6 accounting
    ;; and multiple FIBs
    (push "name netflow:export9 exporter" ngc)
    (push "msg exporter connect %s" ksocket-connect-string)

    ;;
    ;; all this ! stuff is so we can quote separate parameters to the
    ;; ngctl command, when some of those parameters contain spaces,
    ;; without writing every word in a separate string, so you can see
    ;; the netgraph command syntax better. it is ! because none of the
    ;; commands need to include a !.
    (label ((omg (lambda stuff
                   (push (split (apply sprintf stuff) "!") ngc))))
      (dolist (ifc ifs-to-collect)
        (cond
         (first-ifc
          (omg "mkpeer!%s:!netflow!lower!iface%d" ifc nf-port)
          (omg "name!%s:lower!netflow" ifc)
          (omg "connect!%s:!netflow:!upper!out%d" ifc nf-port)
          (setq first-ifc false))
         (true
          (omg "connect!%s:!netflow:!lower!iface%d" ifc nf-port)
          (omg "connect!%s:!netflow:!upper!out%d" ifc nf-port)))
        ;; 7 = INGRESS | EGRESS | ONCE; log both incoming and outgoing packets.
        ;;
        ;; here is the word with the space in it. hold your breath--!
        (omg "msg!netflow:!setconfig!{iface=%d conf=7}" nf-port)
        (setq nf-port (+ 1 nf-port)))
      (omg "mkpeer!netflow:!ksocket!export9!inet/dgram/udp")
      ;; export9 port: use NetFlow V9, which supports IPv6 accounting
      ;; and multiple FIBs
      (omg "name!netflow:export9!exporter")
      (omg "msg!exporter!connect!%s" ksocket-connect-string))

(defun firewall-jail-netflow-collect-setup-commands (ksocket-connect-string)
  (let* ((ngctl-lines-words (firewall-jail-netflow-collect-ngctl-words
                             ksocket-connect-string))
         ;; we shellquote each word so its contents will not be parsed
         ;; by the shell as part of the rc script.
         (quoted-words (mapcar (lambda (line) (mapcar shellquote line))
                               ngctl-lines-words))
         (shell-commands (mapcar (lambda (line)
                                   (sprintf "\tngctl %s\n"
                                            (apply string-join " " line)))
                                 quoted-words)))
    shell-commands))

  (change "add netflow_collect rc.d script"
          (lambda ()
            (dir-exists "/usr/local/etc/rc.d" "755" "root" "wheel")
            (file-exists "/usr/local/etc/rc.d/netflow_collect"
                         "755" "root" "wheel")
            (file-contents-from-gsubs-template
             "/usr/local/etc/rc.d/netflow_collect"
             "netflow_collect_rc.tmpl.m4"
             '(("NGCTL_SETUP_COMMANDS"
                ;; the command will be shellquoted in order to be
                ;; passed to m4; we shellquote it again to be parsed
                ;; by the shell as part of the rc script.
                (mapcar (lambda (cmd) (sprintf "\tngctl %s\n" (shellquote cmd)))
                        (firewall-jail-netflow-collect-ngctl-script
                         ksocket-connect-string)))
               ("NGCTL_TEARDOWN_COMMANDS"
                "\

  
    (change "add netflow_collect rc.d script"
            (lambda ()
              (dir-exists "/usr/local/etc/rc.d" "755" "root" "wheel")
              (file-exists-with-contents-gsubbed
               "/usr/local/etc/rc.d/netflow_collect"
               "755" "root" "wheel"
               "templates/netflow-collect-rc-d.sh.tmpl"
               `(("NGCTL_SETUP_COMMANDS"
                  ,(apply string-join ""
                          (firewall-jail-netflow-collect-setup-commands
                           ksocket-connect-string)))
                 ("NGCTL_TEARDOWN_COMMANDS"
                  "\

          nil))

            nil))

(load "hosts.glotawk")
(defun huph-do ()
  (use-this-host)
  (host-common-bits))
(save-lisp-and-die "../lacrum" "huph-lacrum" 'huph-do)

  (package-installed "doas" nil)

  (package-installed "doas")

(setq he-ddns-columns
      '(kw str name password))

(setq he-ddnses
      '( ((:kw :ebagi)
          (:ifc "re0.87")
          (:str "ebagi")
          (:name "eatenby.agrue.info")
          (:password e"U2FsdGVkX1/LQXI3gtC50NTUSeVpCG2Hb8cZmDXQJVY=")) ))

(setq he-ddns-rows
      '((:ebagi "ebagi" "eatenby.agrue.info" "yvavpFv0iPpYSWq0")))

(defun he-ddns-updating (interface unique-id)
  (do-table (he-ddns-columns he-ddns-rows)
    (file-exists-with-contents-gsubbed
     (sprintf "/etc/dhclient-exit-hooks.d/20-henet_ddns_%s" str)
     "644" "root" "wheel"
     "templates/henet_ddns.tmpl"
     `(("HEDD_INTERFACE" interface)
       ("HEDD_NAME" name)
       ("HEDD_PASSWORD" password)
       ("HEDD_EXT_DNS_IP" he-ddns-external-dns-ip)))))

(defun he-ddns-updating ()
  (dolist (alis he-ddnses)
    (apply
     (lambda (:kw ifc str name password)
       (file-exists-with-contents-gsubbed
        (sprintf "/etc/dhclient-exit-hooks.d/20-henet_ddns_%s" str)
        "644" "root" "wheel"
        "templates/henet_ddns.tmpl"
        `(("HEDD_INTERFACE" ,ifc)
          ("HEDD_NAME" ,name)
          ("HEDD_PASSWORD" ,password)
          ("HEDD_EXT_DNS_IP" ,he-ddns-external-dns-ip))))
     alis)))

(defun he-gif-tunnels (interface)

(defun he-gif-tunnels ()

  (do-ifs-and-vlans chromebox-networking

  (do-ifcs-and-vlans ((vif) vlans chromebox-networking)

             `(("HGT_INTERFACE" interface)
               ("HGT_FAR_IPV4"  (cadr (assoc :far-ipv4  v)))
               ("HGT_USERNAME"  (cadr (assoc :username  v)))
               ("HGT_PASSWORD"  (cadr (assoc :password  v)))
               ("HGT_TUNNELID"  (cadr (assoc :tunnel-id v)))
               ("HGT_NEAR_IPV6" (cadr (assoc :near-ipv6 v)))
               ("HGT_FAR_IPV6"  (cadr (assoc :far-ipv6  v)))))))))))

             `(("HGT_INTERFACE" ,vif)
               ("HGT_FAR_IPV4"  ,(cadr (assoc :far-ipv4  v)))
               ("HGT_USERNAME"  ,(decrypt (cadr (assq :username  v))))
               ("HGT_PASSWORD"  ,(decrypt (cadr (assq :password  v))))
               ("HGT_TUNNELID"  ,(decrypt (cadr (assq :tunnel-id v))))
               ("HGT_NEAR_IPV6" ,(decrypt (cadr (assq :near-ipv6 v))))
               ("HGT_FAR_IPV6"  ,(decrypt (cadr (assq :far-ipv6  v))))))))))))

        (:mtus ("re0" 9193))

        (:mtus (("re0" 9193)))

    ;; for emacs: (put 'do-ifs-and-vlans 'lisp-indent-function 1)

    ;; for emacs: (put 'do-ifcs-and-vlans 'lisp-indent-function 1)

    (do-ifs-and-vlans chromebox-networking

    (do-ifcs-and-vlans ((name mtu ifc fwp v6s v4s vif v_if vid)
                        vlans chromebox-networking)

      ;; to make a do-ifs, it doesn't get rid of enough boilerplate.
      (when (not (member if mtus-set))                      
        (change (sprintf "set mtu for %s" if)
                (lambda ()
                  (sysrc-set (sprintf "ifconfig_%s" if)
                         (sprintf "up mtu %d" mtu))))
        (push if mtus-set))

      ;; to make a do-ifcs, it doesn't get rid of enough boilerplate.
      (when (not (member ifc mtus-set))
        (with-log-rule ("set mtu for %s" ifc)
          (sysrc-set (sprintf "ifconfig_%s" ifc) (sprintf "up mtu %d" mtu)))
        (push ifc mtus-set))

        (change
         (sprintf "add vlan %d to if %s" vid if)
         (lambda () (sysrc-add
                     (sprintf "vlans_%s" if)
                     ;; the leading space clues sysrc in on what
                     ;; separates values in this variable
                     (sprintf " %d" vid)))
         nil)

        (with-log-rule ("add vlan %d to ifc %s" vid ifc)
         (sysrc-add (sprintf "vlans_%s" ifc)
                    ;; the leading space clues sysrc in on what
                    ;; separates values in this variable
                    (sprintf " %d" vid)))

            (change (sprintf "ULA IP for %s" vif)
                    (lambda ()
                      (sysrc-set (sprintf "ifconfig_%s_%d_ipv6" if vid)
                                 (sprintf "inet6 %s/%d" ula-ip 64)))
                    nil)
            (change (sprintf "Global IP for %s" vif)
                    (lambda ()
                      (sysrc-add (sprintf "ifconfig_%s_%d_aliases" if vid)
                                 (sprintf " inet6 %s/%d" global-ip 64)))
                    nil)))
        (when v4sub
          (let ((ipv4 (sprintf "%s.%d.%d" internal-ipv4-16 v4sub my-octet)))
            (change (sprintf "IPv4 for %s" vif)
                    (lambda ()
                      (sysrc-set (sprintf "ifconfig_%s_%d" if vid)
                                 (sprintf "inet %s/%d" ipv4 24)))
                    nil)))
        (change (sprintf "add description to %s.%d" if vid)
                (lambda ()
                  (sysrc-add (sprintf "ifconfig_%s_%d" if vid)
                             (sprintf " descr %s" name))))))))

            (with-log-rule ("ULA IP for %s" vif)
                    (sysrc-set (sprintf "ifconfig_%s_ipv6" v_if)
                               (sprintf "inet6 %s/%d" ula-ip 64)))
            (with-log-rule ("Global IP for %s" vif)
                    (sysrc-add (sprintf "ifconfig_%s_aliases" v_if)
                               (sprintf " inet6 %s/%d" global-ip 64)))))
        (when v4s
          (let ((ipv4 (sprintf "%s.%d.%d" internal-ipv4-16 v4s my-octet)))
            (with-log-rule ("IPv4 for %s" vif)
                    (sysrc-set (sprintf "ifconfig_%s" v_if)
                               (sprintf "inet %s/%d" ipv4 24)))))
        (with-log-rule ("add description to %s" vif)
                (sysrc-set (sprintf "ifconfig_%s_descr" v_if)
                           name))))))

  (change "add suitable jjl user" add-jjl nil)
  (change "let wheel group use doas" doas-for-wheel nil)
  (change "enable sshd" (lambda () (sysrc-set "sshd_enable" "YES")) nil)
  ;;(change "ssh access only via key" openssh-keys-only nil)

  (with-log-rule ("add suitable jjl user") (add-jjl))
  (with-log-rule ("let wheel group use doas") (doas-for-wheel))
  (with-log-rule ("enable sshd") (sysrc-set "sshd_enable" "YES"))
  ;;(with-log-rule ("ssh access only via key") (openssh-keys-only))

  (change "enable netflow collector"
          (lambda () (sysrc-set "netflow_collect_enable" "YES"))
          nil))

  (with-log-rule ("enable netflow collector")
    (sysrc-set "netflow_collect_enable" "YES"))
  (set-up-dhclient-hooks)
  (he-gif-tunnels)
  (he-ddns-updating)
  (dnsmasq)
  (pfsync)
  (pf)
  )

  (package-installed "dnsmasq")
  (let ((ipv4-ranges nil)
        (ipv6-ranges nil)
        (no-dhcp-interfaces nil)
        (dns-listen-interfaces nil)
        (v6opts '("ra-stateless" "ra-names"))
        (template-inputs nil)
        (ifs (assoc-path '(:ethernet-interfaces) chromebox-networking))
        (if-on-vlan (assoc-path '(:interface-on-vlan)
                                chromebox-networking)))
    (do-ifs-and-vlans chromebox-networking
     (cond
      (dhcpp
       (let ((min 100) (max 250))
         (push (sprintf "dhcp-range=set:%s,%s.%d.%d,%s.%d.%d"
                        name
                        internal-ipv4-16 v4sub min
                        internal-ipv4-16 v4sub max)
               ipv4-ranges))
       (push (sprintf "dhcp-range=set:%s,::,constructor:%s%s"
                      name (sprintf "%s.%d" if number)
                      (strcat "," (apply string-join "," v6opts)))
             ipv6-ranges))
      (true
       (push (sprintf "%s.%d" if number) no-dhcp-interfaces)))
     (cond
      (dnsp (push (sprintf "%s.%d" if number) dns-listen-interfaces))))
    (file-exists-with-contents-gsubbed
     "/usr/local/etc/dnsmasq.conf" "644" "root" "wheel"
     "templates/dnsmasq.conf.m4"
     `(("DHCP_IPV4_RANGES" ,(apply string-join "\n" ipv4-ranges))
       ("DHCP_IPV6_RANGES" ,(apply string-join "\n" ipv6-ranges))
       ("NO_DHCP_INTERFACES" ,(apply string-join "," no-dhcp-interfaces))
       ("DNS_INTERFACES"   ,(apply string-join "," dns-listen-interfaces))))
    (sysrc-set "dnsmasq_enable" "YES")
    (file-exists-with-text-copied-from
     "/etc/hosts" "644" "root" "wheel" "files/hosts")
    (file-exists-with-text-copied-from
     "/etc/ethers" "644" "root" "wheel" "files/ethers")))

  (with-log-rule ("dnsmasq: install and configure")
    (package-installed "dnsmasq")
    (let ((ipv4-ranges nil)
          (ipv6-ranges nil)
          (no-dhcp-interfaces nil)
          (dns-listen-interfaces nil)
          (v6opts '("ra-stateless" "ra-names"))
          (template-inputs nil)
          (ifs (assoc-path '(:ethernet-interfaces) chromebox-networking))
          (if-on-vlan (assoc-path '(:interface-on-vlan)
                                  chromebox-networking)))
      (do-ifcs-and-vlans ((dhcpp dnsp v4s vif) vlans chromebox-networking)
        (cond
         (dhcpp
          (let ((min 100) (max 250))
            (push (sprintf "dhcp-range=set:%s,%s.%d.%d,%s.%d.%d"
                           name
                           internal-ipv4-16 v4s min
                           internal-ipv4-16 v4s max)
                  ipv4-ranges))
          (push (sprintf "dhcp-range=set:%s,::,constructor:%s%s"
                         name vif
                         (strcat "," (apply string-join "," v6opts)))
                ipv6-ranges))
         (true
          (push vif no-dhcp-interfaces)))
        (cond
         (dnsp (push vif dns-listen-interfaces))))
      (file-exists-with-contents-gsubbed
       "/usr/local/etc/dnsmasq.conf" "644" "root" "wheel"
       "templates/dnsmasq.conf.m4"
       `(("DHCP_IPV4_RANGES" ,(apply string-join "\n" ipv4-ranges))
         ("DHCP_IPV6_RANGES" ,(apply string-join "\n" ipv6-ranges))
         ("NO_DHCP_INTERFACES" ,(apply string-join "," no-dhcp-interfaces))
         ("DNS_INTERFACES"   ,(apply string-join "," dns-listen-interfaces))))
      (sysrc-set "dnsmasq_enable" "YES")
      (file-exists-with-text-copied-from
       "/etc/hosts" "644" "root" "wheel" "files/hosts")
      (file-exists-with-text-copied-from
       "/etc/ethers" "644" "root" "wheel" "files/ethers"))))

  ;; ... I'm not going to do the /usr/local/etc treatment for this.
  ;; This dhclient is part of the base system and our configuration
  ;; for it is too.
  (dir-exists "/etc/dhclient-enter-hooks.d" "755" "root" "wheel")
  (dir-exists "/etc/dhclient-exit-hooks.d"  "755" "root" "wheel")
  ;; note: these scripts may need to run without /usr/bin being
  ;; mounted first
  (file-exists-with-entire-contents
   "/etc/dhclient-enter-hooks" "644" "root" "wheel"
   "source everything in /etc/dhclient-enter-hooks.d"
   "\

  (with-log-rule ("set up dhclient enter/exit hooks")
    ;; ... I'm not going to do the /usr/local/etc treatment for this.
    ;; This dhclient is part of the base system and our configuration
    ;; for it is too.
    (dir-exists "/etc/dhclient-enter-hooks.d" "755" "root" "wheel")
    (dir-exists "/etc/dhclient-exit-hooks.d"  "755" "root" "wheel")
    ;; note: these scripts may need to run without /usr/bin being
    ;; mounted first
    (file-exists-with-entire-contents
     "/etc/dhclient-enter-hooks" "644" "root" "wheel"
     "source everything in /etc/dhclient-enter-hooks.d"
     "\

  (file-exists-with-entire-contents
   "/etc/dhclient-exit-hooks" "644" "root" "wheel"
   "source everything in /etc/dhclient-exit-hooks.d"
   "\

    (file-exists-with-entire-contents
     "/etc/dhclient-exit-hooks" "644" "root" "wheel"
     "source everything in /etc/dhclient-exit-hooks.d"
     "\

"))

")))

  (do-ifs-and-vlans chromebox-networking
    (when (and fwp carpp)
      (let ((my-addr
             (sprintf "%s:%s::%s" ula-ipv6-48 v6sub my-octet))
            (shared-addr
             (sprintf "%s:%s::%s" ula-ipv6-48 v6sub carp-octet))
            (passphrase (cadr (assoc kw carp-passphrases))))
        ;; As far as I read, the CARPing happens with multicast by
        ;; default and I don't need to address the individual
        ;; members of my CARP pair. But everybody's tutorial has
        ;; the CARP address as an alias on an interface with a
        ;; per-host address as its primary: the FreeBSD Handbook,
        ;; the CARP article by Mariusz Zaborski, and this other
        ;; person from earlier this year.
        ;;
        ;; https://docs.freebsd.org/en/books/handbook/advanced-networking/#carp
        ;;
        ;; https://freebsdfoundation.org/wp-content/uploads/2022/11/zaborski_CARP.pdf
        ;;
        ;; https://www.subnetspider.com/2025/01/22/building-a-fault-tolerant-reverse-proxy-with-freebsd.html
        (sysrc-add (sprintf "ifconfig_%s_%d_aliases" if vid)
                   (sprintf " vhid %d advskew %d pass %s alias %s/%d"
                            vid advskew
                            (unsafe-reveal passphrase)
                            shared-addr))))))

  (with-log-rule ("CARP: configure IPs: I'm %s, shared is %s"
                  my-octet carp-octet)
    (do-ifcs-and-vlans ((fwp carpp v6s kw ifc vid)
                        vlans chromebox-networking)
      (when (and fwp carpp)
        (let ((my-addr
               (sprintf "%s:%s::%s" ula-ipv6-48 v6sub my-octet))
              (shared-addr
               (sprintf "%s:%s::%s" ula-ipv6-48 v6sub carp-octet))
              (passphrase (cadr (assoc kw carp-passphrases))))
          ;; As far as I read, the CARPing happens with multicast by
          ;; default and I don't need to address the individual
          ;; members of my CARP pair. But everybody's tutorial has
          ;; the CARP address as an alias on an interface with a
          ;; per-host address as its primary: the FreeBSD Handbook,
          ;; the CARP article by Mariusz Zaborski, and this other
          ;; person from earlier this year.
          ;;
          ;; https://docs.freebsd.org/en/books/handbook/advanced-networking/#carp
          ;;
          ;; https://freebsdfoundation.org/wp-content/uploads/2022/11/zaborski_CARP.pdf
          ;;
          ;; https://www.subnetspider.com/2025/01/22/building-a-fault-tolerant-reverse-proxy-with-freebsd.html
          (sysrc-add (sprintf "ifconfig_%s_%d_aliases" ifc vid)
                     (sprintf " vhid %d advskew %d pass %s alias %s/%d"
                              vid advskew
                              (unsafe-reveal passphrase)
                              shared-addr)))))))

  (dir-exists carp-script-dir "755" "root" "wheel")
  (file-exists-with-entire-contents-gsubbed  ;; because of all the "'s therein
   "/etc/devd/carp.conf" "644" "root" "wheel"
   "templates/carp_devd.conf.m4"
   `(("CARP_SCRIPTS_DIR" ,carp-script-dir)))
  (let ((subsys (sprintf "%d@%s" vhid interface)))
    (dolist (state '("MASTER" "BACKUP"))
      (let* ((event (sprintf "on-%s-%s" subsys state))
             (this-event-dir
              (sprintf "%s/%s.d" carp-script-dir event))
             (this-event-runner-script
              (sprintf "%s/%s.sh" carp-script-dir event)))
        (dir-exists this-event-dir "755" "root" "wheel")
        (file-exists-with-entire-contents
         this-event-runner-script "755" "root" "wheel"
         (sprintf "run everything in %s" this-event-dir)
         ;; this file's contents, by contrast with the above, don't
         ;; have anything we need to escape when expressing as a
         ;; string literal here.
         (sprintf "\

  (with-log-rule
      ("CARP: set up to do things on state changes for vhid %d on ifc %s"
       vhid interface)
    (dir-exists carp-script-dir "755" "root" "wheel")
    (file-exists-with-entire-contents-gsubbed  ;; because of all the "'s therein
     "/etc/devd/carp.conf" "644" "root" "wheel"
     "templates/carp_devd.conf.m4"
     `(("CARP_SCRIPTS_DIR" ,carp-script-dir)))
    (let ((subsys (sprintf "%d@%s" vhid interface)))
      (dolist (state '("MASTER" "BACKUP"))
        (let* ((event (sprintf "on-%s-%s" subsys state))
               (this-event-dir
                (sprintf "%s/%s.d" carp-script-dir event))
               (this-event-runner-script
                (sprintf "%s/%s.sh" carp-script-dir event)))
          (dir-exists this-event-dir "755" "root" "wheel")
          (file-exists-with-entire-contents
           this-event-runner-script "755" "root" "wheel"
           (sprintf "run everything in %s" this-event-dir)
           ;; this file's contents, by contrast with the above, don't
           ;; have anything we need to escape when expressing as a
           ;; string literal here.
           (sprintf "\

  ;; and now, make scripts like, for example,
  ;; /usr/local/etc/carp-scripts/on-87@re0.87-BACKUP.d/dhcp, which
  ;; will run when we become the BACKUP for the :wan vlan's carp ip
  ;; (which has vhid 87 and belongs to interface re0.87).
  )

    ;; and now, make scripts like, for example,
    ;; /usr/local/etc/carp-scripts/on-87@re0.87-BACKUP.d/dhcp, which
    ;; will run when we become the BACKUP for the :wan vlan's carp ip
    ;; (which has vhid 87 and belongs to interface re0.87).
    ))

  (let* ((subsys (sprintf "%d@%s" vhid interface))
         (event (sprintf "on-%s-%s" subsys state))
         (event-dir (path-join carp-script-dir (strcat event ".d")))
         (script-filename (path-join event-dir identifier)))
    (file-exists-with-entire-contents
     script-filename "755" "root" "wheel"
     (sprintf "when %s goes to %s, deal with aspect %s" subsys state name))))

  (with-log-rule ("CARP: when vhid %d on ifc %s goes %s, deal with %s"
                  vhid interface state name)
    (let* ((subsys (sprintf "%d@%s" vhid interface))
           (event (sprintf "on-%s-%s" subsys state))
           (event-dir (path-join carp-script-dir (strcat event ".d")))
           (script-filename (path-join event-dir identifier)))
      (file-exists-with-entire-contents
       script-filename "755" "root" "wheel"
       (sprintf "when %s goes to %s, deal with aspect %s"
                subsys state name)
       contents))))

  (do-ifs-and-vlans chromebox-networking

  (do-ifcs-and-vlans ((kw fwp) vlans chromebox-networking)

      (sysrc-set "pfsync_enable" "YES")
      (sysrc-set "pfsync_syncdev" if)
      (sysrc-set "pfsync_syncpeer" "ff12::f0"))))

      (with-log-rule ("enable pfsync on ifc %s" ifc)
        (sysrc-set "pfsync_enable" "YES")
        (sysrc-set "pfsync_syncdev" ifc)
        (sysrc-set "pfsync_syncpeer" "ff12::f0")))))

LACRUM = ../lacrum
all: huph-lacrum zuko-lacrum
huph-lacrum: $(LACRUM)
	$(LACRUM) huph.glotawk
zuko-lacrum: $(LACRUM)
	$(LACRUM) zuko.glotawk