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
To reply to this bug, email your comments to 77019 AT debbugs.gnu.org.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, roman <at> burningswell.com, guix-patches <at> gnu.org:bug#77019; Package guix-patches.
(Fri, 14 Mar 2025 19:18:02 GMT) Full text and rfc822 format available.Sergey Trofimov <sarg <at> sarg.org.ru>:ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, roman <at> burningswell.com, guix-patches <at> gnu.org.
(Fri, 14 Mar 2025 19:18:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Sergey Trofimov <sarg <at> sarg.org.ru> To: guix-patches <at> gnu.org Cc: Sergey Trofimov <sarg <at> sarg.org.ru> Subject: [PATCH 0/1] machine: hetzner: Allow attaching existing public IPs. Date: Fri, 14 Mar 2025 20:17:11 +0100
This patch allows attaching existing IP addresses to hetzner VMs. Use it when a static IP address is necessary on the VM. While testing it I've found out that `guile-json` doesn't support nullable fields, so it is not possible to disable v4 or v6 addresses currently (e.g. `(ipv4 #f)`). See https://github.com/aconchillo/guile-json/issues/87 for details. Sergey Trofimov (1): machine: hetzner: Allow attaching existing public IPs. doc/guix.texi | 10 ++++++++++ gnu/machine/hetzner.scm | 25 +++++++++++++++++++++++++ gnu/machine/hetzner/http.scm | 35 +++++++++++++++++++++++++++++------ 3 files changed, 64 insertions(+), 6 deletions(-) base-commit: 9449ab3c2025820d2e6fd679fa7e34832b667ea7 -- 2.48.1
sarg <at> sarg.org.ru, ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, roman <at> burningswell.com, guix-patches <at> gnu.org:bug#77019; Package guix-patches.
(Fri, 14 Mar 2025 19:47:02 GMT) Full text and rfc822 format available.Message #8 received at 77019 <at> debbugs.gnu.org (full text, mbox):
From: Sergey Trofimov <sarg <at> sarg.org.ru> To: 77019 <at> debbugs.gnu.org Cc: Sergey Trofimov <sarg <at> sarg.org.ru> Subject: [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
sarg <at> sarg.org.ru, ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, guix-patches <at> gnu.org:bug#77019; Package guix-patches.
(Thu, 20 Mar 2025 06:51:02 GMT) Full text and rfc822 format available.Message #11 received at 77019 <at> debbugs.gnu.org (full text, mbox):
From: Sergey Trofimov <sarg <at> sarg.org.ru> To: 77019 <at> debbugs.gnu.org Cc: Sergey Trofimov <sarg <at> sarg.org.ru> Subject: [PATCH v1] machine: hetzner: Allow attaching existing public IPs. Date: Thu, 20 Mar 2025 07:50:18 +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 | 36 ++++++++++++++++++++++++++------
tests/machine/hetzner/http.scm | 38 ++++++++++++++++++++++++++++++++++
4 files changed, 103 insertions(+), 6 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index e5894931ff..9352c56563 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -45962,6 +45962,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..33f501f53a 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
@@ -144,6 +152,7 @@ (define-module (gnu machine hetzner http)
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,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 +599,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 +612,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 +677,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"
diff --git a/tests/machine/hetzner/http.scm b/tests/machine/hetzner/http.scm
index 618d9a4c94..6c6d848a57 100644
--- a/tests/machine/hetzner/http.scm
+++ b/tests/machine/hetzner/http.scm
@@ -239,6 +239,30 @@ (define server-x86-alist
("status" . "running")
("volumes" . #())))
+(define primary-ip
+ (make-hetzner-primary-ip
+ #(55 2 19 28 9 123 6 300 -1 0 #f)
+ 42
+ "131.232.99.1"
+ '()
+ "static-ip"
+ "ipv4"))
+
+(define primary-ip-alist
+ `(("created" . "2023-10-28T19:02:55+00:00")
+ ("id" . 42)
+ ("labels")
+ ("name" . "static-ip")
+ ("blocked" . #f)
+ ("ip" . "131.232.99.1")
+ ("datacenter")
+ ("dns_ptr")
+ ("protection" . (("delete" . #f)))
+ ("type" . "ipv4")
+ ("auto_delete" . #t)
+ ("assignee_type" . "server")
+ ("assignee_id" . 17)))
+
(define ssh-key-root
(make-hetzner-ssh-key
#(55 2 19 28 9 123 6 300 -1 0 #f)
@@ -512,6 +536,20 @@ (define-syntax-rule (with-cleanup-api (api-sym api-init) body ...)
("ssh_keys" . #(,ssh-key-root-alist)))))))
(hetzner-api-ssh-keys (hetzner-api))))
+(test-equal "hetzner-api-primary-ips-unit"
+ (list primary-ip)
+ (mock ((gnu machine hetzner http) hetzner-api-request-send
+ (lambda* (request #:key expected)
+ (assert (equal? 'GET (hetzner-api-request-method request)))
+ (assert (equal? "https://api.hetzner.cloud/v1/primary_ips"
+ (hetzner-api-request-url request)))
+ (assert (unspecified? (hetzner-api-request-body request)))
+ (assert (equal? '(("page" . 1)) (hetzner-api-request-params request)))
+ (hetzner-api-response
+ (body `(("meta" . ,meta-page-alist)
+ ("primary_ips" . #(,primary-ip-alist)))))))
+ (hetzner-api-primary-ips (hetzner-api))))
+
;; Integration tests
(test-skip %when-no-token)
base-commit: 77ff73a920759437639e8eb77601e51409fefefa
prerequisite-patch-id: f9cc903b8048c8c6fde576fbf38ab110263020e3
prerequisite-patch-id: 220ddf11addf3a6c7ab3b349077bca6849241556
--
2.48.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.