asmodeus.rkt

netconf/asmodeus.rkt

@@ -1,7 +1,14 @@
 #lang racket
-'(set firewall (global-options state-policy
-                               (established action accept)
-                               (related action accept)
-                               (invalid action accept))
-      (group network-group
-             (dn42-allowed-transit-v4 network ("10.0.0.0/8" "172.20.0.0/14" "172.31.0.0/16"))))
+
+(require "util.rkt")
+
+(commandtree->string
+ '(set firewall
+       (global-options state-policy [(established action accept)
+                                     (related action accept)
+                                     (invalid action accept)])
+       (group network-group
+              (dn42-allowed-transit-v4 network
+                                       ("10.0.0.0/8")
+                                       ("172.20.0.0/14")
+                                       ("172.31.0.0/16")))))

netconf/dn42.rkt

@@ -0,0 +1,28 @@
+#lang racket
+
+(define bgp-afs '(ipv4-unicast ipv6-unicast))
+(define dn42-roa-route-map "dn42-roa")
+
+(define (dn42-bgp-group)
+  `[(delete protocols bgp peer-group dn42)
+    (set protocols bgp peer-group dn42
+         [(capability extended-nexthop)
+          ,(for/list ([af bgp-afs])
+             `(,af [(route-map export ,dn42-roa-route-map)
+                    (route-map import ,dn42-roa-route-map)
+                    (soft-reconfiguration inbound)]))])])
+
+(define (dn42-route-collector)
+  (define addr "fd42:4242:2601:ac12::1")
+  (define routemap 'deny-all)
+
+  `[(delete policy route-map ,routemap)
+    (set policy route-map ,routemap rule 1 action deny)
+
+    (delete protocols bgp neighbor ,addr)
+    (set protocols bgp neighbor ,addr
+         [(capability extended-nexthop)
+          ,(for/list ([af bgp-afs]) `(address-family ,af route-map import ,routemap))
+          (description "https://lg.collector.dn42")
+          (ebgp-multihop 10)
+          (remote-as 4242422602)])])

netconf/util.rkt

@@ -35,7 +35,8 @@
    (set policy route-map dn42-roa rule 30 match rpki invalid))]})
  wireguard/tunnel:render-vyos
  wireguard/tunnel
- wireguard/peer)
+ wireguard/peer
+ commandtree->string)
 
 (define (command->string c)
   (string-join (map (match-lambda
@@ -53,6 +54,9 @@
                              (expand-command-tree subtree)))
                       lists))]))
 
+(define (commandtree->string t)
+  (map command->string (expand-command-tree t)))
+
 (define/match (split-at-first-list l)
   [((cons (? list? l) rest)) (cons '() (cons l rest))]
   [((cons obj rest)) (match-define (cons before after) (split-at-first-list rest))