From: Aljosha Papsch <ep@stern-data.com>
To: 49255@debbugs.gnu.org
Cc: Aljosha Papsch <ep@stern-data.com>
Subject: [bug#49255] [PATCH 2/4] gnu: Add wondershaper service.
Date: Mon, 28 Jun 2021 17:22:30 +0200 [thread overview]
Message-ID: <20210628152232.31073-3-ep@stern-data.com> (raw)
In-Reply-To: <20210628152232.31073-1-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(-)
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.")))
+\f
+;;;
+;;; 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
next prev parent reply other threads:[~2021-06-28 15:25 UTC|newest]
Thread overview: 11+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-06-28 15:22 [bug#49258] [PATCH] Add wondershaper package and service Aljosha Papsch
2021-06-28 15:22 ` [bug#49254] [PATCH 1/4] gnu: Add wondershaper Aljosha Papsch
2021-06-30 20:15 ` Maxime Devos
2021-06-28 15:22 ` Aljosha Papsch [this message]
2021-06-28 15:22 ` [bug#49256] [PATCH 3/4] guix.texi: Document wondershaper-service-type Aljosha Papsch
2021-06-28 15:22 ` [bug#49257] [PATCH 4/4] Add wondershaper related copright lines Aljosha Papsch
2021-07-09 13:54 ` [bug#49258] [PATCH v2] Revise wondershaper package Aljosha Papsch
2021-07-09 13:54 ` [bug#49258] [PATCH 1/4] gnu: Add wondershaper Aljosha Papsch
2021-07-09 13:54 ` [bug#49258] [PATCH 2/4] gnu: Add wondershaper service Aljosha Papsch
2021-07-09 13:54 ` [bug#49258] [PATCH 3/4] guix.texi: Document wondershaper-service-type Aljosha Papsch
2021-07-09 13:54 ` [bug#49258] [PATCH 4/4] Add wondershaper related copright lines Aljosha Papsch
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210628152232.31073-3-ep@stern-data.com \
--to=ep@stern-data.com \
--cc=49255@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).