Package: guix-patches;
Reported by: Sergey Trofimov <sarg <at> sarg.org.ru>
Date: Fri, 14 Mar 2025 19:18:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Sergey Trofimov <sarg <at> sarg.org.ru> To: 77019 <at> debbugs.gnu.org Cc: Sergey Trofimov <sarg <at> sarg.org.ru>, Sergey Trofimov <sarg <at> sarg.org.ru>, Ludovic Courtès <ludo <at> gnu.org>, Maxim Cournoyer <maxim.cournoyer <at> gmail.com>, Roman Scherer <roman <at> burningswell.com> Subject: [bug#77019] [PATCH] machine: hetzner: Allow attaching existing public IPs. Date: Fri, 14 Mar 2025 20:46:16 +0100
* 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: Document it.
---
doc/guix.texi | 10 ++++++++++
gnu/machine/hetzner.scm | 25 +++++++++++++++++++++++++
gnu/machine/hetzner/http.scm | 35 +++++++++++++++++++++++++++++------
3 files changed, 64 insertions(+), 6 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 49ac018913..4a35f3ea13 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -45919,6 +45919,16 @@ Invoking guix deploy
provisioning phase. If false, the server will be kept in order to debug
any issues.
+@item @code{ipv4} (default: @code{'create})
+When false, no public IPv4 address is going to be attached. Specify the
+name of an existing primary ip to attach it to the machine. Other values
+would create a new address automatically.
+
+@item @code{ipv6} (default: @code{'create})
+When false, no public IPv6 address is going to be attached. Specify the
+name of an existing primary ip to attach it to the machine. Other values
+would create a new address automatically.
+
@item @code{labels} (default: @code{'()})
A user defined alist of key/value pairs attached to the SSH key and the
server on the Hetzner API. Keys and values must be strings,
diff --git a/gnu/machine/hetzner.scm b/gnu/machine/hetzner.scm
index e8484e4d51..c1ccab54ae 100644
--- a/gnu/machine/hetzner.scm
+++ b/gnu/machine/hetzner.scm
@@ -73,6 +73,8 @@ (define-module (gnu machine hetzner)
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 @@ (define-record-type* <hetzner-configuration> hetzner-configuration
(default "fsn1"))
(server-type hetzner-configuration-server-type ; string
(default "cx42"))
+ (ipv4 hetzner-configuration-ipv4
+ (default 'create))
+ (ipv6 hetzner-configuration-ipv6
+ (default 'create))
(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 @@ (define (hetzner-machine-server machine)
(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 @@ (define (hetzner-machine-create-server machine)
(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))
+ ipv4)
#:labels (hetzner-configuration-labels config)
#:location (hetzner-configuration-location config)
#:server-type (hetzner-configuration-server-type config)))
diff --git a/gnu/machine/hetzner/http.scm b/gnu/machine/hetzner/http.scm
index 51b4bff984..6a82558fbe 100644
--- a/gnu/machine/hetzner/http.scm
+++ b/gnu/machine/hetzner/http.scm
@@ -52,6 +52,7 @@ (define-module (gnu machine hetzner http)
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 @@ (define-module (gnu machine hetzner http)
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
@@ -296,6 +304,15 @@ (define-json-mapping <hetzner-server-type>
(name hetzner-server-type-name) ; string
(storage-type hetzner-server-type-storage-type "storage_type")) ; string
+(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 +598,11 @@ (define* (hetzner-api-locations api . options)
(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 +611,11 @@ (define* (hetzner-api-server-create
#: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 +676,11 @@ (define* (hetzner-api-ssh-keys api . options)
(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"
base-commit: 412f411d4f8780e6b60b448caae17f01c09be0eb
--
2.48.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.