tribes/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 13:10:33 +02:00
Code Activity

machine: hetzner: Allow attaching existing public IPs.

Browse Source 
* gnu/machine/hetzner.scm (hetzner-configuration): Add ipv4 and ipv6
fields. Export accessors.
* gnu/machine/hetzner/http.scm (hetnzer-api-primary-ips): New function.
(<hetzner-primary-ip>): New json mapping.
(hetzner-api-server-create): Pass IP addresses in request.
* doc/guix.texi (Invoking guix deploy): Document it.

Change-Id: I44509cc98e041762dc483e876566e79bde85b26a
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Sergey Trofimov
2025-04-18 17:08:08 +02:00
committed by Ludovic Courtès
parent 5f1ee7ba73
commit 7a4193ec4a
4 changed files with 100 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
gnu/machine/hetzner.scm
View File

@@ -73,6 +73,8 @@
hetzner-configuration-authorize?
hetzner-configuration-build-locally?
hetzner-configuration-delete?
hetzner-configuration-ipv4
hetzner-configuration-ipv6
hetzner-configuration-labels
hetzner-configuration-location
hetzner-configuration-server-type
@@ -205,6 +207,10 @@ Have you run 'guix archive --generate-key'?")
(default "fsn1"))
(server-type hetzner-configuration-server-type ; string
(default "cx42"))
(ipv4 hetzner-configuration-ipv4 ; boolean | string
(default #t))
(ipv6 hetzner-configuration-ipv6 ; boolean | string
(default #t))
(ssh-public-key hetzner-configuration-ssh-public-key ; public-key | string
(thunked)
(default (public-key-from-file (hetzner-configuration-ssh-key this-hetzner-configuration)))
@@ -445,6 +451,17 @@ values: list of output lines returned by CMD and its exit code."
(hetzner-configuration-api config)
#:params `(("name" . ,(machine-display-name machine)))))))
(define (hetzner-resolve-ip api name)
"Find the NAME IP address on the Hetzner API."
(or
(find (lambda (primary-ip)
(equal? name (hetzner-primary-ip-name primary-ip)))
(hetzner-api-primary-ips api #:params `(("name" . ,name))))
(raise-exception
(formatted-message (G_ "primary ip '~a' does not exist.")
name))))
(define (hetzner-machine-create-server machine)
"Create the Hetzner server for MACHINE."
(let* ((config (machine-configuration machine))
@@ -452,11 +469,19 @@ values: list of output lines returned by CMD and its exit code."
(server-type (hetzner-configuration-server-type config)))
(format #t "creating '~a' server for '~a'...\n" server-type name)
(let* ((ssh-key (hetzner-machine-ssh-key machine))
(ipv4 (hetzner-configuration-ipv4 config))
(ipv6 (hetzner-configuration-ipv6 config))
(api (hetzner-configuration-api config))
(server (hetzner-api-server-create
api
(machine-display-name machine)
(list ssh-key)
#:ipv4 (if (string? ipv4)
(hetzner-primary-ip-id (hetzner-resolve-ip api ipv4))
ipv4)
#:ipv6 (if (string? ipv6)
(hetzner-primary-ip-id (hetzner-resolve-ip api ipv6))
ipv6)
#:labels (hetzner-configuration-labels config)
#:location (hetzner-configuration-location config)
#:server-type (hetzner-configuration-server-type config)))

37
gnu/machine/hetzner/http.scm
View File

@@ -52,6 +52,7 @@
hetzner-api-actions
hetzner-api-create-ssh-key
hetzner-api-locations
hetzner-api-primary-ips
hetzner-api-request-body
hetzner-api-request-headers
hetzner-api-request-method
@@ -100,6 +101,13 @@
hetzner-location-name
hetzner-location-network-zone
hetzner-location?
hetzner-primary-ip
hetzner-primary-ip-created
hetzner-primary-ip-id
hetzner-primary-ip-ip
hetzner-primary-ip-labels
hetzner-primary-ip-name
hetzner-primary-ip-type
hetzner-public-net
hetzner-public-net-ipv4
hetzner-public-net-ipv6
@@ -144,6 +152,7 @@
make-hetzner-ipv6
make-hetzner-location
make-hetzner-public-net
make-hetzner-primary-ip
make-hetzner-resource
make-hetzner-server
make-hetzner-server-type
@@ -296,6 +305,16 @@
(name hetzner-server-type-name) ; string
(storage-type hetzner-server-type-storage-type "storage_type")) ; string
;; Reserved IP address. https://docs.hetzner.cloud/#primary-ips
(define-json-mapping <hetzner-primary-ip>
make-hetzner-primary-ip hetzner-primary-ip? json->hetzner-primary-ip
(created hetzner-primary-ip-created "created" string->time) ; time
(id hetzner-primary-ip-id) ; integer
(ip hetzner-primary-ip-ip) ; string
(labels hetzner-primary-ip-labels) ; alist of string/string
(name hetzner-primary-ip-name) ; string
(type hetzner-primary-ip-type)) ; string
(define-json-mapping <hetzner-ssh-key>
make-hetzner-ssh-key hetzner-ssh-key? json->hetzner-ssh-key
(created hetzner-ssh-key-created "created" string->time) ; time
@@ -581,12 +600,11 @@
(define* (hetzner-api-server-create
api name ssh-keys
#:key
(enable-ipv4? #t)
(enable-ipv6? #t)
(ipv4 #f)
(ipv6 #f)
(image %hetzner-default-server-image)
(labels '())
(location %hetzner-default-server-location)
(public-net #f)
(server-type %hetzner-default-server-type)
(start-after-create? #f))
"Create a server with the Hetzner API."
@@ -595,9 +613,11 @@
#:body `(("image" . ,image)
("labels" . ,labels)
("name" . ,name)
("public_net"
. (("enable_ipv4" . ,enable-ipv4?)
("enable_ipv6" . ,enable-ipv6?)))
("public_net" .
(("enable_ipv4" . ,(and ipv4 #t))
("enable_ipv6" . ,(and ipv6 #t))
,@(if (integer? ipv4) `(("ipv4" . ,ipv4)) '())
,@(if (integer? ipv6) `(("ipv6" . ,ipv6)) '())))
("location" . ,location)
("server_type" . ,server-type)
("ssh_keys" . ,(apply vector (map hetzner-ssh-key-id ssh-keys)))
@@ -658,6 +678,11 @@
(apply hetzner-api-list api "/ssh_keys" "ssh_keys"
json->hetzner-ssh-key options))
(define* (hetzner-api-primary-ips api . options)
"Get Primary IPs from the Hetzner API."
(apply hetzner-api-list api "/primary_ips" "primary_ips"
json->hetzner-primary-ip options))
(define* (hetzner-api-server-types api . options)
"Get server types from the Hetzner API."
(apply hetzner-api-list api "/server_types" "server_types"