[PATCH 2/4] gnu: Add wondershaper service.

  • Open
  • quality assurance status badge
Details
2 participants
  • Aljosha Papsch
  • Leo Prikler
Owner
unassigned
Submitted by
Aljosha Papsch
Severity
normal
Merged with
A
A
Aljosha Papsch wrote on 28 Jun 2021 17:22
(address . guix-patches@gnu.org)(name . Aljosha Papsch)(address . ep@stern-data.com)
20210628152232.31073-3-ep@stern-data.com
* gnu/services/networking.scm (wondershaper-configuration): New symbol.
Configuration for wondershaper-service-type.
* gnu/services/networking.scm (wondershaper-configuration?): New symbol.
Predicate for wondershaper-configuration.
* gnu/services/networking.scm (wondershaper-service-type): New symbol.
One-shot service running wondershaper with a generated config file.
---
gnu/services/networking.scm | 107 +++++++++++++++++++++++++++++++++++-
1 file changed, 106 insertions(+), 1 deletion(-)

Toggle diff (125 lines)
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 87b3d754a3..a17f41aa30 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -221,7 +221,11 @@
keepalived-configuration
keepalived-configuration?
- keepalived-service-type))
+ keepalived-service-type
+
+ wondershaper-configuration
+ wondershaper-configuration?
+ wondershaper-service-type))
;;; Commentary:
;;;
@@ -2190,4 +2194,105 @@ of the IPFS peer-to-peer storage network.")))
"Run @uref{https://www.keepalived.org/, Keepalived}
routing software.")))
+
+;;;
+;;; Wondershaper
+;;;
+
+(define %wondershaper-default-download-speed 2048)
+
+(define-record-type* <wondershaper-configuration>
+ wondershaper-configuration make-wondershaper-configuration
+ wondershaper-configuration?
+ (wondershaper wondershaper-configuration-wondershaper ;<package>
+ (default wondershaper))
+ (interface wondershaper-configuration-interface ;string
+ (default "eth0"))
+ (download-speed wondershaper-configuration-download-speed ;number (kbps)
+ (default %wondershaper-default-download-speed))
+ (upload-speed wondershaper-configuration-upload-speed ;number (kbps)
+ (default 512))
+ (prio-3-rate wondershaper-configuration-prio-3-rate ;number (kbps)
+ (default (/ (* 20 %wondershaper-default-download-speed) 100)))
+ (prio-3-ceil wondershaper-configuration-prio-3-ceil
+ (default (/ (* 90 %wondershaper-default-download-speed) 100)))
+ (high-prio-dest wondershaper-configuration-high-prio-dest ;list of ip addresses
+ (default '()))
+ (no-prio-host-src wondershaper-configuration-no-prio-host-src ;list of ip addresses
+ (default '()))
+ (no-prio-host-dest wondershaper-configuration-no-prio-host-dest ;list of ip addresses
+ (default '()))
+ (no-prio-port-src wondershaper-configuration-no-prio-port-src ;list of port numbers
+ (default '()))
+ (no-prio-port-dest wondershaper-configuration-no-prio-port-dest ;list of port numbers
+ (default '())))
+
+(define wondershaper-config-file
+ (match-lambda
+ (($ <wondershaper-configuration> _ interface download-speed
+ upload-speed prio-3-rate prio-3-ceil high-prio-dest
+ no-prio-host-src no-prio-host-dest
+ no-prio-port-src no-prio-port-dest)
+ (begin
+ (define (shell-quote str)
+ "Return STR wrapped in single quotes, with every single quote in the string escaped."
+ (let ((quote-char (lambda (chr)
+ (if (eq? chr #\')
+ "'\\''"
+ (string chr)))))
+ (string-append
+ "'"
+ (let loop ((chars (string->list str))
+ (result ""))
+ (match chars
+ (() result)
+ ((head tail ...)
+ (loop tail
+ (string-append result
+ (quote-char head))))))
+ "'")))
+ (define (list->bash-array lst)
+ (string-append "(" (string-join (map shell-quote lst)) ")"))
+ (define (format-config)
+ (string-append
+ "IFACE=" (shell-quote interface) "
+DSPEED=\"" (number->string download-speed) "\"
+USPEED=\"" (number->string upload-speed) "\"
+PRIO_3_RATE=\"" (number->string prio-3-rate) "\"
+PRIO_3_CEIL=\"" (number->string prio-3-ceil) "\"
+HIPRIODST=" (list->bash-array high-prio-dest) "
+NOPRIOHOSTSRC=" (list->bash-array no-prio-host-src) "
+NOPRIOHOSTDST=" (list->bash-array no-prio-host-dest) "
+NOPRIOPORTSRC=" (list->bash-array (map number->string no-prio-port-src)) "
+NOPRIOPORTDST=" (list->bash-array (map number->string no-prio-port-dest)) "
+"))
+ (computed-file
+ "wondershaper.conf"
+ #~(call-with-output-file #$output
+ (lambda (port)
+ (display "# Generated by wondershaper-service\n" port)
+ (display #$(format-config) port))))))))
+
+(define (wondershaper-shepherd-service config)
+ (match config
+ (($ <wondershaper-configuration> wondershaper)
+ (list (shepherd-service
+ (provision '(wondershaper))
+ (documentation "Configure traffic control")
+ (requirement '(networking))
+ (start #~(lambda _
+ (invoke #$(file-append wondershaper "/bin/wondershaper")
+ "-p" "-f" #$(wondershaper-config-file config))))
+ (one-shot? #t))))))
+
+(define wondershaper-service-type
+ (service-type
+ (name 'wondershaper)
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ wondershaper-shepherd-service)))
+ (default-value (wondershaper-configuration))
+ (description "Run @uref{https://github.com/magnific0/wondershaper,
+wondershaper}, a small utility script setting up traffic control (tc).")))
+
;;; networking.scm ends here
--
2.32.0
L
L
Leo Prikler wrote on 28 Jun 2021 17:36
(address . control@debbugs.gnu.org)
d7c0e430e623075f514b77880fb0f8810493b39b.camel@student.tugraz.at
merge 49254 49255 49256 49257 49258
thanks
?
Your comment

Commenting via the web interface is currently disabled.

To comment on this conversation send an email to 49255@debbugs.gnu.org

To respond to this issue using the mumi CLI, first switch to it
mumi current 49255
Then, you may apply the latest patchset in this issue (with sign off)
mumi am -- -s
Or, compose a reply to this issue
mumi compose
Or, send patches to this issue
mumi send-email *.patch