networking.scm 84 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
  3. ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
  4. ;;; Copyright © 2016, 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
  5. ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
  6. ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
  7. ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
  8. ;;; Copyright © 2017, 2018 Marius Bakke <mbakke@fastmail.com>
  9. ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
  10. ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
  11. ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
  12. ;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
  13. ;;; Copyright © 2019, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
  14. ;;; Copyright © 2019 Sou Bunnbu <iyzsong@member.fsf.org>
  15. ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
  16. ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
  17. ;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
  18. ;;; Copyright © 2021 Christopher Lemmer Webber <cwebber@dustycloud.org>
  19. ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
  20. ;;;
  21. ;;; This file is part of GNU Guix.
  22. ;;;
  23. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  24. ;;; under the terms of the GNU General Public License as published by
  25. ;;; the Free Software Foundation; either version 3 of the License, or (at
  26. ;;; your option) any later version.
  27. ;;;
  28. ;;; GNU Guix is distributed in the hope that it will be useful, but
  29. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  30. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  31. ;;; GNU General Public License for more details.
  32. ;;;
  33. ;;; You should have received a copy of the GNU General Public License
  34. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  35. (define-module (gnu services networking)
  36. #:use-module (gnu services)
  37. #:use-module (gnu services base)
  38. #:use-module (gnu services configuration)
  39. #:use-module (gnu services linux)
  40. #:use-module (gnu services shepherd)
  41. #:use-module (gnu services dbus)
  42. #:use-module (gnu system shadow)
  43. #:use-module (gnu system pam)
  44. #:use-module (gnu packages admin)
  45. #:use-module (gnu packages base)
  46. #:use-module (gnu packages bash)
  47. #:use-module (gnu packages cluster)
  48. #:use-module (gnu packages connman)
  49. #:use-module (gnu packages freedesktop)
  50. #:use-module (gnu packages linux)
  51. #:use-module (gnu packages tor)
  52. #:use-module (gnu packages usb-modeswitch)
  53. #:use-module (gnu packages messaging)
  54. #:use-module (gnu packages networking)
  55. #:use-module (gnu packages ntp)
  56. #:use-module (gnu packages wicd)
  57. #:use-module (gnu packages gnome)
  58. #:use-module (gnu packages ipfs)
  59. #:use-module (gnu build linux-container)
  60. #:use-module (guix gexp)
  61. #:use-module (guix records)
  62. #:use-module (guix modules)
  63. #:use-module (guix packages)
  64. #:use-module (guix deprecation)
  65. #:use-module (rnrs enums)
  66. #:use-module (srfi srfi-1)
  67. #:use-module (srfi srfi-9)
  68. #:use-module (srfi srfi-26)
  69. #:use-module (srfi srfi-43)
  70. #:use-module (ice-9 match)
  71. #:use-module (json)
  72. #:re-export (static-networking-service
  73. static-networking-service-type)
  74. #:export (%facebook-host-aliases
  75. dhcp-client-service
  76. dhcp-client-service-type
  77. dhcpd-service-type
  78. dhcpd-configuration
  79. dhcpd-configuration?
  80. dhcpd-configuration-package
  81. dhcpd-configuration-config-file
  82. dhcpd-configuration-version
  83. dhcpd-configuration-run-directory
  84. dhcpd-configuration-lease-file
  85. dhcpd-configuration-pid-file
  86. dhcpd-configuration-interfaces
  87. ntp-configuration
  88. ntp-configuration?
  89. ntp-configuration-ntp
  90. ntp-configuration-servers
  91. ntp-allow-large-adjustment?
  92. %ntp-servers
  93. ntp-server
  94. ntp-server-type
  95. ntp-server-address
  96. ntp-server-options
  97. ntp-service
  98. ntp-service-type
  99. %openntpd-servers
  100. openntpd-configuration
  101. openntpd-configuration?
  102. openntpd-service-type
  103. inetd-configuration
  104. inetd-entry
  105. inetd-service-type
  106. opendht-configuration
  107. opendht-configuration-peer-discovery?
  108. opendht-configuration-verbose?
  109. opendht-configuration-bootstrap-host
  110. opendht-configuration-port
  111. opendht-configuration-proxy-server-port
  112. opendht-configuration-proxy-server-port-tls
  113. opendht-configuration->command-line-arguments
  114. opendht-shepherd-service
  115. opendht-service-type
  116. tor-configuration
  117. tor-configuration?
  118. tor-hidden-service
  119. tor-service
  120. tor-service-type
  121. wicd-service-type
  122. wicd-service
  123. network-manager-configuration
  124. network-manager-configuration?
  125. network-manager-configuration-dns
  126. network-manager-configuration-vpn-plugins
  127. network-manager-service-type
  128. connman-configuration
  129. connman-configuration?
  130. connman-service-type
  131. modem-manager-configuration
  132. modem-manager-configuration?
  133. modem-manager-service-type
  134. usb-modeswitch-configuration
  135. usb-modeswitch-configuration?
  136. usb-modeswitch-configuration-usb-modeswitch
  137. usb-modeswitch-configuration-usb-modeswitch-data
  138. usb-modeswitch-service-type
  139. wpa-supplicant-configuration
  140. wpa-supplicant-configuration?
  141. wpa-supplicant-configuration-wpa-supplicant
  142. wpa-supplicant-configuration-requirement
  143. wpa-supplicant-configuration-pid-file
  144. wpa-supplicant-configuration-dbus?
  145. wpa-supplicant-configuration-interface
  146. wpa-supplicant-configuration-config-file
  147. wpa-supplicant-configuration-extra-options
  148. wpa-supplicant-service-type
  149. hostapd-configuration
  150. hostapd-configuration?
  151. hostapd-configuration-package
  152. hostapd-configuration-interface
  153. hostapd-configuration-ssid
  154. hostapd-configuration-broadcast-ssid?
  155. hostapd-configuration-channel
  156. hostapd-configuration-driver
  157. hostapd-service-type
  158. simulated-wifi-service-type
  159. openvswitch-service-type
  160. openvswitch-configuration
  161. iptables-configuration
  162. iptables-configuration?
  163. iptables-configuration-iptables
  164. iptables-configuration-ipv4-rules
  165. iptables-configuration-ipv6-rules
  166. iptables-service-type
  167. nftables-service-type
  168. nftables-configuration
  169. nftables-configuration?
  170. nftables-configuration-package
  171. nftables-configuration-ruleset
  172. %default-nftables-ruleset
  173. pagekite-service-type
  174. pagekite-configuration
  175. pagekite-configuration?
  176. pagekite-configuration-package
  177. pagekite-configuration-kitename
  178. pagekite-configuration-kitesecret
  179. pagekite-configuration-frontend
  180. pagekite-configuration-kites
  181. pagekite-configuration-extra-file
  182. yggdrasil-service-type
  183. yggdrasil-configuration
  184. yggdrasil-configuration?
  185. yggdrasil-configuration-autoconf?
  186. yggdrasil-configuration-config-file
  187. yggdrasil-configuration-log-level
  188. yggdrasil-configuration-log-to
  189. yggdrasil-configuration-json-config
  190. yggdrasil-configuration-package
  191. ipfs-service-type
  192. ipfs-configuration
  193. ipfs-configuration?
  194. ipfs-configuration-package
  195. ipfs-configuration-gateway
  196. ipfs-configuration-api
  197. keepalived-configuration
  198. keepalived-configuration?
  199. keepalived-service-type))
  200. ;;; Commentary:
  201. ;;;
  202. ;;; Networking services.
  203. ;;;
  204. ;;; Code:
  205. (define %facebook-host-aliases
  206. ;; This is the list of known Facebook hosts to be added to /etc/hosts if you
  207. ;; are to block it.
  208. "\
  209. # Block Facebook IPv4.
  210. 127.0.0.1 www.facebook.com
  211. 127.0.0.1 facebook.com
  212. 127.0.0.1 login.facebook.com
  213. 127.0.0.1 www.login.facebook.com
  214. 127.0.0.1 fbcdn.net
  215. 127.0.0.1 www.fbcdn.net
  216. 127.0.0.1 fbcdn.com
  217. 127.0.0.1 www.fbcdn.com
  218. 127.0.0.1 static.ak.fbcdn.net
  219. 127.0.0.1 static.ak.connect.facebook.com
  220. 127.0.0.1 connect.facebook.net
  221. 127.0.0.1 www.connect.facebook.net
  222. 127.0.0.1 apps.facebook.com
  223. # Block Facebook IPv6.
  224. fe80::1%lo0 facebook.com
  225. fe80::1%lo0 login.facebook.com
  226. fe80::1%lo0 www.login.facebook.com
  227. fe80::1%lo0 fbcdn.net
  228. fe80::1%lo0 www.fbcdn.net
  229. fe80::1%lo0 fbcdn.com
  230. fe80::1%lo0 www.fbcdn.com
  231. fe80::1%lo0 static.ak.fbcdn.net
  232. fe80::1%lo0 static.ak.connect.facebook.com
  233. fe80::1%lo0 connect.facebook.net
  234. fe80::1%lo0 www.connect.facebook.net
  235. fe80::1%lo0 apps.facebook.com\n")
  236. (define dhcp-client-service-type
  237. (shepherd-service-type
  238. 'dhcp-client
  239. (lambda (dhcp)
  240. (define dhclient
  241. (file-append dhcp "/sbin/dhclient"))
  242. (define pid-file
  243. "/var/run/dhclient.pid")
  244. (shepherd-service
  245. (documentation "Set up networking via DHCP.")
  246. (requirement '(user-processes udev))
  247. ;; XXX: Running with '-nw' ("no wait") avoids blocking for a minute when
  248. ;; networking is unavailable, but also means that the interface is not up
  249. ;; yet when 'start' completes. To wait for the interface to be ready, one
  250. ;; should instead monitor udev events.
  251. (provision '(networking))
  252. (start #~(lambda _
  253. ;; When invoked without any arguments, 'dhclient' discovers all
  254. ;; non-loopback interfaces *that are up*. However, the relevant
  255. ;; interfaces are typically down at this point. Thus we perform
  256. ;; our own interface discovery here.
  257. (define valid?
  258. (lambda (interface)
  259. (and (arp-network-interface? interface)
  260. (not (loopback-network-interface? interface))
  261. ;; XXX: Make sure the interfaces are up so that
  262. ;; 'dhclient' can actually send/receive over them.
  263. ;; Ignore those that cannot be activated.
  264. (false-if-exception
  265. (set-network-interface-up interface)))))
  266. (define ifaces
  267. (filter valid? (all-network-interface-names)))
  268. (false-if-exception (delete-file #$pid-file))
  269. (let ((pid (fork+exec-command
  270. (cons* #$dhclient "-nw"
  271. "-pf" #$pid-file ifaces))))
  272. (and (zero? (cdr (waitpid pid)))
  273. (read-pid-file #$pid-file)))))
  274. (stop #~(make-kill-destructor))))
  275. isc-dhcp
  276. (description "Run @command{dhcp}, a Dynamic Host Configuration
  277. Protocol (DHCP) client, on all the non-loopback network interfaces.")))
  278. (define-deprecated (dhcp-client-service #:key (dhcp isc-dhcp))
  279. dhcp-client-service-type
  280. "Return a service that runs @var{dhcp}, a Dynamic Host Configuration
  281. Protocol (DHCP) client, on all the non-loopback network interfaces."
  282. (service dhcp-client-service-type dhcp))
  283. (define-record-type* <dhcpd-configuration>
  284. dhcpd-configuration make-dhcpd-configuration
  285. dhcpd-configuration?
  286. (package dhcpd-configuration-package ;<package>
  287. (default isc-dhcp))
  288. (config-file dhcpd-configuration-config-file ;file-like
  289. (default #f))
  290. (version dhcpd-configuration-version ;"4", "6", or "4o6"
  291. (default "4"))
  292. (run-directory dhcpd-configuration-run-directory
  293. (default "/run/dhcpd"))
  294. (lease-file dhcpd-configuration-lease-file
  295. (default "/var/db/dhcpd.leases"))
  296. (pid-file dhcpd-configuration-pid-file
  297. (default "/run/dhcpd/dhcpd.pid"))
  298. ;; list of strings, e.g. (list "enp0s25")
  299. (interfaces dhcpd-configuration-interfaces
  300. (default '())))
  301. (define dhcpd-shepherd-service
  302. (match-lambda
  303. (($ <dhcpd-configuration> package config-file version run-directory
  304. lease-file pid-file interfaces)
  305. (unless config-file
  306. (error "Must supply a config-file"))
  307. (list (shepherd-service
  308. ;; Allow users to easily run multiple versions simultaneously.
  309. (provision (list (string->symbol
  310. (string-append "dhcpv" version "-daemon"))))
  311. (documentation (string-append "Run the DHCPv" version " daemon"))
  312. (requirement '(networking))
  313. (start #~(make-forkexec-constructor
  314. '(#$(file-append package "/sbin/dhcpd")
  315. #$(string-append "-" version)
  316. "-lf" #$lease-file
  317. "-pf" #$pid-file
  318. "-cf" #$config-file
  319. #$@interfaces)
  320. #:pid-file #$pid-file))
  321. (stop #~(make-kill-destructor)))))))
  322. (define dhcpd-activation
  323. (match-lambda
  324. (($ <dhcpd-configuration> package config-file version run-directory
  325. lease-file pid-file interfaces)
  326. (with-imported-modules '((guix build utils))
  327. #~(begin
  328. (unless (file-exists? #$run-directory)
  329. (mkdir #$run-directory))
  330. ;; According to the DHCP manual (man dhcpd.leases), the lease
  331. ;; database must be present for dhcpd to start successfully.
  332. (unless (file-exists? #$lease-file)
  333. (with-output-to-file #$lease-file
  334. (lambda _ (display ""))))
  335. ;; Validate the config.
  336. (invoke/quiet
  337. #$(file-append package "/sbin/dhcpd") "-t" "-cf"
  338. #$config-file))))))
  339. (define dhcpd-service-type
  340. (service-type
  341. (name 'dhcpd)
  342. (extensions
  343. (list (service-extension shepherd-root-service-type dhcpd-shepherd-service)
  344. (service-extension activation-service-type dhcpd-activation)))
  345. (description "Run a DHCP (Dynamic Host Configuration Protocol) daemon. The
  346. daemon is responsible for allocating IP addresses to its client.")))
  347. ;;;
  348. ;;; NTP.
  349. ;;;
  350. (define ntp-server-types (make-enumeration
  351. '(pool
  352. server
  353. peer
  354. broadcast
  355. manycastclient)))
  356. (define-record-type* <ntp-server>
  357. ntp-server make-ntp-server
  358. ntp-server?
  359. ;; The type can be one of the symbols of the NTP-SERVER-TYPE? enumeration.
  360. (type ntp-server-type
  361. (default 'server))
  362. (address ntp-server-address) ; a string
  363. ;; The list of options can contain single option names or tuples in the form
  364. ;; '(name value).
  365. (options ntp-server-options
  366. (default '())))
  367. (define (ntp-server->string ntp-server)
  368. ;; Serialize the NTP server object as a string, ready to use in the NTP
  369. ;; configuration file.
  370. (define (flatten lst)
  371. (reverse
  372. (let loop ((x lst)
  373. (res '()))
  374. (if (list? x)
  375. (fold loop res x)
  376. (cons (format #f "~a" x) res)))))
  377. (match ntp-server
  378. (($ <ntp-server> type address options)
  379. ;; XXX: It'd be neater if fields were validated at the syntax level (for
  380. ;; static ones at least). Perhaps the Guix record type could support a
  381. ;; predicate property on a field?
  382. (unless (enum-set-member? type ntp-server-types)
  383. (error "Invalid NTP server type" type))
  384. (string-join (cons* (symbol->string type)
  385. address
  386. (flatten options))))))
  387. (define %ntp-servers
  388. ;; Default set of NTP servers. These URLs are managed by the NTP Pool project.
  389. ;; Within Guix, Leo Famulari <leo@famulari.name> is the administrative contact
  390. ;; for this NTP pool "zone".
  391. (list
  392. (ntp-server
  393. (type 'pool)
  394. (address "0.guix.pool.ntp.org")
  395. (options '("iburst"))))) ;as recommended in the ntpd manual
  396. (define-record-type* <ntp-configuration>
  397. ntp-configuration make-ntp-configuration
  398. ntp-configuration?
  399. (ntp ntp-configuration-ntp
  400. (default ntp))
  401. (servers %ntp-configuration-servers ;list of <ntp-server> objects
  402. (default %ntp-servers))
  403. (allow-large-adjustment? ntp-allow-large-adjustment?
  404. (default #t))) ;as recommended in the ntpd manual
  405. (define (ntp-configuration-servers ntp-configuration)
  406. ;; A wrapper to support the deprecated form of this field.
  407. (let ((ntp-servers (%ntp-configuration-servers ntp-configuration)))
  408. (match ntp-servers
  409. (((? string?) (? string?) ...)
  410. (format (current-error-port) "warning: Defining NTP servers as strings is \
  411. deprecated. Please use <ntp-server> records instead.\n")
  412. (map (lambda (addr)
  413. (ntp-server
  414. (type 'server)
  415. (address addr)
  416. (options '()))) ntp-servers))
  417. ((($ <ntp-server>) ($ <ntp-server>) ...)
  418. ntp-servers))))
  419. (define ntp-shepherd-service
  420. (lambda (config)
  421. (match config
  422. (($ <ntp-configuration> ntp servers allow-large-adjustment?)
  423. (let ((servers (ntp-configuration-servers config)))
  424. ;; TODO: Add authentication support.
  425. (define config
  426. (string-append "driftfile /var/run/ntpd/ntp.drift\n"
  427. (string-join (map ntp-server->string servers)
  428. "\n")
  429. "
  430. # Disable status queries as a workaround for CVE-2013-5211:
  431. # <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
  432. restrict default kod nomodify notrap nopeer noquery limited
  433. restrict -6 default kod nomodify notrap nopeer noquery limited
  434. # Yet, allow use of the local 'ntpq'.
  435. restrict 127.0.0.1
  436. restrict -6 ::1
  437. # This is required to use servers from a pool directive when using the 'nopeer'
  438. # option by default, as documented in the 'ntp.conf' manual.
  439. restrict source notrap nomodify noquery\n"))
  440. (define ntpd.conf
  441. (plain-file "ntpd.conf" config))
  442. (list (shepherd-service
  443. (provision '(ntpd))
  444. (documentation "Run the Network Time Protocol (NTP) daemon.")
  445. (requirement '(user-processes networking))
  446. (start #~(make-forkexec-constructor
  447. (list (string-append #$ntp "/bin/ntpd") "-n"
  448. "-c" #$ntpd.conf "-u" "ntpd"
  449. #$@(if allow-large-adjustment?
  450. '("-g")
  451. '()))))
  452. (stop #~(make-kill-destructor)))))))))
  453. (define %ntp-accounts
  454. (list (user-account
  455. (name "ntpd")
  456. (group "nogroup")
  457. (system? #t)
  458. (comment "NTP daemon user")
  459. (home-directory "/var/empty")
  460. (shell (file-append shadow "/sbin/nologin")))))
  461. (define (ntp-service-activation config)
  462. "Return the activation gexp for CONFIG."
  463. (with-imported-modules '((guix build utils))
  464. #~(begin
  465. (use-modules (guix build utils))
  466. (define %user
  467. (getpw "ntpd"))
  468. (let ((directory "/var/run/ntpd"))
  469. (mkdir-p directory)
  470. (chown directory (passwd:uid %user) (passwd:gid %user))))))
  471. (define ntp-service-type
  472. (service-type (name 'ntp)
  473. (extensions
  474. (list (service-extension shepherd-root-service-type
  475. ntp-shepherd-service)
  476. (service-extension account-service-type
  477. (const %ntp-accounts))
  478. (service-extension activation-service-type
  479. ntp-service-activation)))
  480. (description
  481. "Run the @command{ntpd}, the Network Time Protocol (NTP)
  482. daemon of the @uref{http://www.ntp.org, Network Time Foundation}. The daemon
  483. will keep the system clock synchronized with that of the given servers.")
  484. (default-value (ntp-configuration))))
  485. (define-deprecated (ntp-service #:key (ntp ntp)
  486. (servers %ntp-servers)
  487. allow-large-adjustment?)
  488. ntp-service-type
  489. "Return a service that runs the daemon from @var{ntp}, the
  490. @uref{http://www.ntp.org, Network Time Protocol package}. The daemon will
  491. keep the system clock synchronized with that of @var{servers}.
  492. @var{allow-large-adjustment?} determines whether @command{ntpd} is allowed to
  493. make an initial adjustment of more than 1,000 seconds."
  494. (service ntp-service-type
  495. (ntp-configuration (ntp ntp)
  496. (servers servers)
  497. (allow-large-adjustment?
  498. allow-large-adjustment?))))
  499. ;;;
  500. ;;; OpenNTPD.
  501. ;;;
  502. (define %openntpd-servers
  503. (map ntp-server-address %ntp-servers))
  504. (define-record-type* <openntpd-configuration>
  505. openntpd-configuration make-openntpd-configuration
  506. openntpd-configuration?
  507. (openntpd openntpd-configuration-openntpd
  508. (default openntpd))
  509. (listen-on openntpd-listen-on
  510. (default '("127.0.0.1"
  511. "::1")))
  512. (query-from openntpd-query-from
  513. (default '()))
  514. (sensor openntpd-sensor
  515. (default '()))
  516. (server openntpd-server
  517. (default '()))
  518. (servers openntpd-servers
  519. (default %openntpd-servers))
  520. (constraint-from openntpd-constraint-from
  521. (default '()))
  522. (constraints-from openntpd-constraints-from
  523. (default '())))
  524. (define (openntpd-configuration->string config)
  525. (define (quote-field? name)
  526. (member name '("constraints from")))
  527. (match-record config <openntpd-configuration>
  528. (listen-on query-from sensor server servers constraint-from
  529. constraints-from)
  530. (string-append
  531. (string-join
  532. (concatenate
  533. (filter-map (lambda (field values)
  534. (match values
  535. (() #f) ;discard entry with filter-map
  536. ((val ...) ;validate value type
  537. (map (lambda (value)
  538. (if (quote-field? field)
  539. (format #f "~a \"~a\"" field value)
  540. (format #f "~a ~a" field value)))
  541. values))))
  542. ;; The entry names.
  543. '("listen on" "query from" "sensor" "server" "servers"
  544. "constraint from" "constraints from")
  545. ;; The corresponding entry values.
  546. (list listen-on query-from sensor server servers
  547. constraint-from constraints-from)))
  548. "\n")
  549. "\n"))) ;add a trailing newline
  550. (define (openntpd-shepherd-service config)
  551. (let ((openntpd (openntpd-configuration-openntpd config)))
  552. (define ntpd.conf
  553. (plain-file "ntpd.conf" (openntpd-configuration->string config)))
  554. (list (shepherd-service
  555. (provision '(ntpd))
  556. (documentation "Run the Network Time Protocol (NTP) daemon.")
  557. (requirement '(user-processes networking))
  558. (start #~(make-forkexec-constructor
  559. (list (string-append #$openntpd "/sbin/ntpd")
  560. "-f" #$ntpd.conf
  561. "-d") ;; don't daemonize
  562. ;; When ntpd is daemonized it repeatedly tries to respawn
  563. ;; while running, leading shepherd to disable it. To
  564. ;; prevent spamming stderr, redirect output to logfile.
  565. #:log-file "/var/log/ntpd"))
  566. (stop #~(make-kill-destructor))))))
  567. (define (openntpd-service-activation config)
  568. "Return the activation gexp for CONFIG."
  569. (with-imported-modules '((guix build utils))
  570. #~(begin
  571. (use-modules (guix build utils))
  572. (mkdir-p "/var/db")
  573. (mkdir-p "/var/run")
  574. (unless (file-exists? "/var/db/ntpd.drift")
  575. (with-output-to-file "/var/db/ntpd.drift"
  576. (lambda _
  577. (format #t "0.0")))))))
  578. (define openntpd-service-type
  579. (service-type (name 'openntpd)
  580. (extensions
  581. (list (service-extension shepherd-root-service-type
  582. openntpd-shepherd-service)
  583. (service-extension account-service-type
  584. (const %ntp-accounts))
  585. (service-extension profile-service-type
  586. (compose list openntpd-configuration-openntpd))
  587. (service-extension activation-service-type
  588. openntpd-service-activation)))
  589. (default-value (openntpd-configuration))
  590. (description
  591. "Run the @command{ntpd}, the Network Time Protocol (NTP)
  592. daemon, as implemented by @uref{http://www.openntpd.org, OpenNTPD}. The
  593. daemon will keep the system clock synchronized with that of the given servers.")))
  594. ;;;
  595. ;;; Inetd.
  596. ;;;
  597. (define-record-type* <inetd-configuration> inetd-configuration
  598. make-inetd-configuration
  599. inetd-configuration?
  600. (program inetd-configuration-program ;file-like
  601. (default (file-append inetutils "/libexec/inetd")))
  602. (entries inetd-configuration-entries ;list of <inetd-entry>
  603. (default '())))
  604. (define-record-type* <inetd-entry> inetd-entry make-inetd-entry
  605. inetd-entry?
  606. (node inetd-entry-node ;string or #f
  607. (default #f))
  608. (name inetd-entry-name) ;string, from /etc/services
  609. (socket-type inetd-entry-socket-type) ;stream | dgram | raw |
  610. ;rdm | seqpacket
  611. (protocol inetd-entry-protocol) ;string, from /etc/protocols
  612. (wait? inetd-entry-wait? ;Boolean
  613. (default #t))
  614. (user inetd-entry-user) ;string
  615. (program inetd-entry-program ;string or file-like object
  616. (default "internal"))
  617. (arguments inetd-entry-arguments ;list of strings or file-like objects
  618. (default '())))
  619. (define (inetd-config-file entries)
  620. (apply mixed-text-file "inetd.conf"
  621. (map
  622. (lambda (entry)
  623. (let* ((node (inetd-entry-node entry))
  624. (name (inetd-entry-name entry))
  625. (socket
  626. (if node (string-append node ":" name) name))
  627. (type
  628. (match (inetd-entry-socket-type entry)
  629. ((or 'stream 'dgram 'raw 'rdm 'seqpacket)
  630. (symbol->string (inetd-entry-socket-type entry)))))
  631. (protocol (inetd-entry-protocol entry))
  632. (wait (if (inetd-entry-wait? entry) "wait" "nowait"))
  633. (user (inetd-entry-user entry))
  634. (program (inetd-entry-program entry))
  635. (args (inetd-entry-arguments entry)))
  636. #~(string-append
  637. (string-join
  638. (list #$@(list socket type protocol wait user program) #$@args)
  639. " ") "\n")))
  640. entries)))
  641. (define inetd-shepherd-service
  642. (match-lambda
  643. (($ <inetd-configuration> program ()) '()) ; empty list of entries -> do nothing
  644. (($ <inetd-configuration> program entries)
  645. (list
  646. (shepherd-service
  647. (documentation "Run inetd.")
  648. (provision '(inetd))
  649. (requirement '(user-processes networking syslogd))
  650. (start #~(make-forkexec-constructor
  651. (list #$program #$(inetd-config-file entries))
  652. #:pid-file "/var/run/inetd.pid"))
  653. (stop #~(make-kill-destructor)))))))
  654. (define-public inetd-service-type
  655. (service-type
  656. (name 'inetd)
  657. (extensions
  658. (list (service-extension shepherd-root-service-type
  659. inetd-shepherd-service)))
  660. ;; The service can be extended with additional lists of entries.
  661. (compose concatenate)
  662. (extend (lambda (config entries)
  663. (inetd-configuration
  664. (inherit config)
  665. (entries (append (inetd-configuration-entries config)
  666. entries)))))
  667. (description
  668. "Start @command{inetd}, the @dfn{Internet superserver}. It is responsible
  669. for listening on Internet sockets and spawning the corresponding services on
  670. demand.")))
  671. ;;;
  672. ;;; OpenDHT, the distributed hash table network used by Jami
  673. ;;;
  674. (define-maybe/no-serialization number)
  675. (define-maybe/no-serialization string)
  676. ;;; To generate the documentation of the following configuration record, you
  677. ;;; can evaluate: (configuration->documentation 'opendht-configuration)
  678. (define-configuration/no-serialization opendht-configuration
  679. (opendht
  680. (package opendht)
  681. "The @code{opendht} package to use.")
  682. (peer-discovery?
  683. (boolean #false)
  684. "Whether to enable the multicast local peer discovery mechanism.")
  685. (enable-logging?
  686. (boolean #false)
  687. "Whether to enable logging messages to syslog. It is disabled by default
  688. as it is rather verbose.")
  689. (debug?
  690. (boolean #false)
  691. "Whether to enable debug-level logging messages. This has no effect if
  692. logging is disabled.")
  693. (bootstrap-host
  694. (maybe-string "bootstrap.jami.net:4222")
  695. "The node host name that is used to make the first connection to the
  696. network. A specific port value can be provided by appending the @code{:PORT}
  697. suffix. By default, it uses the Jami bootstrap nodes, but any host can be
  698. specified here. It's also possible to disable bootstrapping by setting this
  699. to the @code{'disabled} symbol.")
  700. (port
  701. (maybe-number 4222)
  702. "The UDP port to bind to. When set to @code{'disabled}, an available port
  703. is automatically selected.")
  704. (proxy-server-port
  705. (maybe-number 'disabled)
  706. "Spawn a proxy server listening on the specified port.")
  707. (proxy-server-port-tls
  708. (maybe-number 'disabled)
  709. "Spawn a proxy server listening to TLS connections on the specified
  710. port."))
  711. (define %opendht-accounts
  712. ;; User account and groups for Tor.
  713. (list (user-group (name "opendht") (system? #t))
  714. (user-account
  715. (name "opendht")
  716. (group "opendht")
  717. (system? #t)
  718. (comment "OpenDHT daemon user")
  719. (home-directory "/var/empty")
  720. (shell (file-append shadow "/sbin/nologin")))))
  721. (define (opendht-configuration->command-line-arguments config)
  722. "Derive the command line arguments used to launch the OpenDHT daemon from
  723. CONFIG, an <opendht-configuration> object."
  724. (match-record config <opendht-configuration>
  725. (opendht bootstrap-host enable-logging? port debug? peer-discovery?
  726. proxy-server-port proxy-server-port-tls)
  727. (let ((dhtnode #~(string-append #$opendht:tools "/bin/dhtnode")))
  728. `(,dhtnode
  729. "--service" ;non-forking mode
  730. ,@(if (string? bootstrap-host)
  731. (list "--bootstrap" bootstrap-host))
  732. ,@(if enable-logging?
  733. (list "--syslog")
  734. '())
  735. ,@(if (number? port)
  736. (list "--port" (number->string port))
  737. '())
  738. ,@(if debug?
  739. (list "--verbose")
  740. '())
  741. ,@(if peer-discovery?
  742. (list "--peer-discovery")
  743. '())
  744. ,@(if (number? proxy-server-port)
  745. (list "--proxyserver" (number->string proxy-server-port))
  746. '())
  747. ,@(if (number? proxy-server-port-tls)
  748. (list "--proxyserverssl" (number->string proxy-server-port-tls))
  749. '())))))
  750. (define (opendht-shepherd-service config)
  751. "Return a <shepherd-service> running OpenDHT."
  752. (with-imported-modules (source-module-closure
  753. '((gnu build shepherd)
  754. (gnu system file-systems)))
  755. (shepherd-service
  756. (documentation "Run an OpenDHT node.")
  757. (provision '(opendht dhtnode dhtproxy))
  758. (requirement '(networking syslogd))
  759. (modules '((gnu build shepherd)
  760. (gnu system file-systems)))
  761. (start #~(make-forkexec-constructor/container
  762. (list #$@(opendht-configuration->command-line-arguments config))
  763. #:mappings (list (file-system-mapping
  764. (source "/dev/log") ;for syslog
  765. (target source)))
  766. #:user "opendht"
  767. #:group "opendht"))
  768. (stop #~(make-kill-destructor)))))
  769. (define opendht-service-type
  770. (service-type
  771. (name 'opendht)
  772. (default-value (opendht-configuration))
  773. (extensions
  774. (list (service-extension shepherd-root-service-type
  775. (compose list opendht-shepherd-service))
  776. (service-extension account-service-type
  777. (const %opendht-accounts))))
  778. (description "Run the OpenDHT @command{dhtnode} command that allows
  779. participating in the distributed hash table based OpenDHT network. The
  780. service can be configured to act as a proxy to the distributed network, which
  781. can be useful for portable devices where minimizing energy consumption is
  782. paramount. OpenDHT was originally based on Kademlia and adapted for
  783. applications in communication. It is used by Jami, for example.")))
  784. ;;;
  785. ;;; Tor.
  786. ;;;
  787. (define-record-type* <tor-configuration>
  788. tor-configuration make-tor-configuration
  789. tor-configuration?
  790. (tor tor-configuration-tor
  791. (default tor))
  792. (config-file tor-configuration-config-file
  793. (default (plain-file "empty" "")))
  794. (hidden-services tor-configuration-hidden-services
  795. (default '()))
  796. (socks-socket-type tor-configuration-socks-socket-type ; 'tcp or 'unix
  797. (default 'tcp))
  798. (control-socket? tor-control-socket-path
  799. (default #f)))
  800. (define %tor-accounts
  801. ;; User account and groups for Tor.
  802. (list (user-group (name "tor") (system? #t))
  803. (user-account
  804. (name "tor")
  805. (group "tor")
  806. (system? #t)
  807. (comment "Tor daemon user")
  808. (home-directory "/var/empty")
  809. (shell (file-append shadow "/sbin/nologin")))))
  810. (define-record-type <hidden-service>
  811. (hidden-service name mapping)
  812. hidden-service?
  813. (name hidden-service-name) ;string
  814. (mapping hidden-service-mapping)) ;list of port/address tuples
  815. (define (tor-configuration->torrc config)
  816. "Return a 'torrc' file for CONFIG."
  817. (match config
  818. (($ <tor-configuration> tor config-file services
  819. socks-socket-type control-socket?)
  820. (computed-file
  821. "torrc"
  822. (with-imported-modules '((guix build utils))
  823. #~(begin
  824. (use-modules (guix build utils)
  825. (ice-9 match))
  826. (call-with-output-file #$output
  827. (lambda (port)
  828. (display "\
  829. ### These lines were generated from your system configuration:
  830. User tor
  831. DataDirectory /var/lib/tor
  832. PidFile /var/run/tor/tor.pid
  833. Log notice syslog\n" port)
  834. (when (eq? 'unix '#$socks-socket-type)
  835. (display "\
  836. SocksPort unix:/var/run/tor/socks-sock
  837. UnixSocksGroupWritable 1\n" port))
  838. (when #$control-socket?
  839. (display "\
  840. ControlSocket unix:/var/run/tor/control-sock GroupWritable RelaxDirModeCheck
  841. ControlSocketsGroupWritable 1\n"
  842. port))
  843. (for-each (match-lambda
  844. ((service (ports hosts) ...)
  845. (format port "\
  846. HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
  847. service)
  848. (for-each (lambda (tcp-port host)
  849. (format port "\
  850. HiddenServicePort ~a ~a~%"
  851. tcp-port host))
  852. ports hosts)))
  853. '#$(map (match-lambda
  854. (($ <hidden-service> name mapping)
  855. (cons name mapping)))
  856. services))
  857. (display "\
  858. ### End of automatically generated lines.\n\n" port)
  859. ;; Append the user's config file.
  860. (call-with-input-file #$config-file
  861. (lambda (input)
  862. (dump-port input port)))
  863. #t))))))))
  864. (define (tor-shepherd-service config)
  865. "Return a <shepherd-service> running Tor."
  866. (match config
  867. (($ <tor-configuration> tor)
  868. (let ((torrc (tor-configuration->torrc config)))
  869. (with-imported-modules (source-module-closure
  870. '((gnu build shepherd)
  871. (gnu system file-systems)))
  872. (list (shepherd-service
  873. (provision '(tor))
  874. ;; Tor needs at least one network interface to be up, hence the
  875. ;; dependency on 'loopback'.
  876. (requirement '(user-processes loopback syslogd))
  877. (modules '((gnu build shepherd)
  878. (gnu system file-systems)))
  879. (start #~(make-forkexec-constructor/container
  880. (list #$(file-append tor "/bin/tor") "-f" #$torrc)
  881. #:mappings (list (file-system-mapping
  882. (source "/var/lib/tor")
  883. (target source)
  884. (writable? #t))
  885. (file-system-mapping
  886. (source "/dev/log") ;for syslog
  887. (target source))
  888. (file-system-mapping
  889. (source "/var/run/tor")
  890. (target source)
  891. (writable? #t)))
  892. #:pid-file "/var/run/tor/tor.pid"))
  893. (stop #~(make-kill-destructor))
  894. (documentation "Run the Tor anonymous network overlay."))))))))
  895. (define (tor-activation config)
  896. "Set up directories for Tor and its hidden services, if any."
  897. #~(begin
  898. (use-modules (guix build utils))
  899. (define %user
  900. (getpw "tor"))
  901. (define (initialize service)
  902. (let ((directory (string-append "/var/lib/tor/hidden-services/"
  903. service)))
  904. (mkdir-p directory)
  905. (chown directory (passwd:uid %user) (passwd:gid %user))
  906. ;; The daemon bails out if we give wider permissions.
  907. (chmod directory #o700)))
  908. ;; Allow Tor to write its PID file.
  909. (mkdir-p "/var/run/tor")
  910. (chown "/var/run/tor" (passwd:uid %user) (passwd:gid %user))
  911. ;; Set the group permissions to rw so that if the system administrator
  912. ;; has specified UnixSocksGroupWritable=1 in their torrc file, members
  913. ;; of the "tor" group will be able to use the SOCKS socket.
  914. (chmod "/var/run/tor" #o750)
  915. ;; Allow Tor to access the hidden services' directories.
  916. (mkdir-p "/var/lib/tor")
  917. (chown "/var/lib/tor" (passwd:uid %user) (passwd:gid %user))
  918. (chmod "/var/lib/tor" #o700)
  919. ;; Make sure /var/lib is accessible to the 'tor' user.
  920. (chmod "/var/lib" #o755)
  921. (for-each initialize
  922. '#$(map hidden-service-name
  923. (tor-configuration-hidden-services config)))))
  924. (define tor-service-type
  925. (service-type (name 'tor)
  926. (extensions
  927. (list (service-extension shepherd-root-service-type
  928. tor-shepherd-service)
  929. (service-extension account-service-type
  930. (const %tor-accounts))
  931. (service-extension activation-service-type
  932. tor-activation)))
  933. ;; This can be extended with hidden services.
  934. (compose concatenate)
  935. (extend (lambda (config services)
  936. (tor-configuration
  937. (inherit config)
  938. (hidden-services
  939. (append (tor-configuration-hidden-services config)
  940. services)))))
  941. (default-value (tor-configuration))
  942. (description
  943. "Run the @uref{https://torproject.org, Tor} anonymous
  944. networking daemon.")))
  945. (define-deprecated (tor-service #:optional
  946. (config-file (plain-file "empty" ""))
  947. #:key (tor tor))
  948. tor-service-type
  949. "Return a service to run the @uref{https://torproject.org, Tor} anonymous
  950. networking daemon.
  951. The daemon runs as the @code{tor} unprivileged user. It is passed
  952. @var{config-file}, a file-like object, with an additional @code{User tor} line
  953. and lines for hidden services added via @code{tor-hidden-service}. Run
  954. @command{man tor} for information about the configuration file."
  955. (service tor-service-type
  956. (tor-configuration (tor tor)
  957. (config-file config-file))))
  958. (define tor-hidden-service-type
  959. ;; A type that extends Tor with hidden services.
  960. (service-type (name 'tor-hidden-service)
  961. (extensions
  962. (list (service-extension tor-service-type list)))
  963. (description
  964. "Define a new Tor @dfn{hidden service}.")))
  965. (define (tor-hidden-service name mapping)
  966. "Define a new Tor @dfn{hidden service} called @var{name} and implementing
  967. @var{mapping}. @var{mapping} is a list of port/host tuples, such as:
  968. @example
  969. '((22 \"127.0.0.1:22\")
  970. (80 \"127.0.0.1:8080\"))
  971. @end example
  972. In this example, port 22 of the hidden service is mapped to local port 22, and
  973. port 80 is mapped to local port 8080.
  974. This creates a @file{/var/lib/tor/hidden-services/@var{name}} directory, where
  975. the @file{hostname} file contains the @code{.onion} host name for the hidden
  976. service.
  977. See @uref{https://www.torproject.org/docs/tor-hidden-service.html.en, the Tor
  978. project's documentation} for more information."
  979. (service tor-hidden-service-type
  980. (hidden-service name mapping)))
  981. ;;;
  982. ;;; Wicd.
  983. ;;;
  984. (define %wicd-activation
  985. ;; Activation gexp for Wicd.
  986. #~(begin
  987. (use-modules (guix build utils))
  988. (mkdir-p "/etc/wicd")
  989. (let ((file-name "/etc/wicd/dhclient.conf.template.default"))
  990. (unless (file-exists? file-name)
  991. (copy-file (string-append #$wicd file-name)
  992. file-name)))
  993. ;; Wicd invokes 'wpa_supplicant', which needs this directory for its
  994. ;; named socket files.
  995. (mkdir-p "/var/run/wpa_supplicant")
  996. (chmod "/var/run/wpa_supplicant" #o750)))
  997. (define (wicd-shepherd-service wicd)
  998. "Return a shepherd service for WICD."
  999. (list (shepherd-service
  1000. (documentation "Run the Wicd network manager.")
  1001. (provision '(networking))
  1002. (requirement '(user-processes dbus-system loopback))
  1003. (start #~(make-forkexec-constructor
  1004. (list (string-append #$wicd "/sbin/wicd")
  1005. "--no-daemon")))
  1006. (stop #~(make-kill-destructor)))))
  1007. (define wicd-service-type
  1008. (service-type (name 'wicd)
  1009. (extensions
  1010. (list (service-extension shepherd-root-service-type
  1011. wicd-shepherd-service)
  1012. (service-extension dbus-root-service-type
  1013. list)
  1014. (service-extension activation-service-type
  1015. (const %wicd-activation))
  1016. ;; Add Wicd to the global profile.
  1017. (service-extension profile-service-type list)))
  1018. (description
  1019. "Run @url{https://launchpad.net/wicd,Wicd}, a network
  1020. management daemon that aims to simplify wired and wireless networking.")))
  1021. (define* (wicd-service #:key (wicd wicd))
  1022. "Return a service that runs @url{https://launchpad.net/wicd,Wicd}, a network
  1023. management daemon that aims to simplify wired and wireless networking.
  1024. This service adds the @var{wicd} package to the global profile, providing
  1025. several commands to interact with the daemon and configure networking:
  1026. @command{wicd-client}, a graphical user interface, and the @command{wicd-cli}
  1027. and @command{wicd-curses} user interfaces."
  1028. (service wicd-service-type wicd))
  1029. ;;;
  1030. ;;; ModemManager
  1031. ;;;
  1032. (define-record-type* <modem-manager-configuration>
  1033. modem-manager-configuration make-modem-manager-configuration
  1034. modem-manager-configuration?
  1035. (modem-manager modem-manager-configuration-modem-manager
  1036. (default modem-manager)))
  1037. ;;;
  1038. ;;; NetworkManager
  1039. ;;;
  1040. (define-record-type* <network-manager-configuration>
  1041. network-manager-configuration make-network-manager-configuration
  1042. network-manager-configuration?
  1043. (network-manager network-manager-configuration-network-manager
  1044. (default network-manager))
  1045. (dns network-manager-configuration-dns
  1046. (default "default"))
  1047. (vpn-plugins network-manager-configuration-vpn-plugins ;list of <package>
  1048. (default '())))
  1049. (define network-manager-activation
  1050. ;; Activation gexp for NetworkManager
  1051. (match-lambda
  1052. (($ <network-manager-configuration> network-manager dns vpn-plugins)
  1053. #~(begin
  1054. (use-modules (guix build utils))
  1055. (mkdir-p "/etc/NetworkManager/system-connections")
  1056. #$@(if (equal? dns "dnsmasq")
  1057. ;; create directory to store dnsmasq lease file
  1058. '((mkdir-p "/var/lib/misc"))
  1059. '())))))
  1060. (define (vpn-plugin-directory plugins)
  1061. "Return a directory containing PLUGINS, the NM VPN plugins."
  1062. (directory-union "network-manager-vpn-plugins" plugins))
  1063. (define (network-manager-accounts config)
  1064. "Return the list of <user-account> and <user-group> for CONFIG."
  1065. (define nologin
  1066. (file-append shadow "/sbin/nologin"))
  1067. (define accounts
  1068. (append-map (lambda (package)
  1069. (map (lambda (name)
  1070. (user-account (system? #t)
  1071. (name name)
  1072. (group "network-manager")
  1073. (comment "NetworkManager helper")
  1074. (home-directory "/var/empty")
  1075. (create-home-directory? #f)
  1076. (shell nologin)))
  1077. (or (assoc-ref (package-properties package)
  1078. 'user-accounts)
  1079. '())))
  1080. (network-manager-configuration-vpn-plugins config)))
  1081. (match accounts
  1082. (()
  1083. '())
  1084. (_
  1085. (cons (user-group (name "network-manager") (system? #t))
  1086. accounts))))
  1087. (define network-manager-environment
  1088. (match-lambda
  1089. (($ <network-manager-configuration> network-manager dns vpn-plugins)
  1090. ;; Define this variable in the global environment such that
  1091. ;; "nmcli connection import type openvpn file foo.ovpn" works.
  1092. `(("NM_VPN_PLUGIN_DIR"
  1093. . ,(file-append (vpn-plugin-directory vpn-plugins)
  1094. "/lib/NetworkManager/VPN"))))))
  1095. (define network-manager-shepherd-service
  1096. (match-lambda
  1097. (($ <network-manager-configuration> network-manager dns vpn-plugins)
  1098. (let ((conf (plain-file "NetworkManager.conf"
  1099. (string-append "[main]\ndns=" dns "\n")))
  1100. (vpn (vpn-plugin-directory vpn-plugins)))
  1101. (list (shepherd-service
  1102. (documentation "Run the NetworkManager.")
  1103. (provision '(networking))
  1104. (requirement '(user-processes dbus-system wpa-supplicant loopback))
  1105. (start #~(make-forkexec-constructor
  1106. (list (string-append #$network-manager
  1107. "/sbin/NetworkManager")
  1108. (string-append "--config=" #$conf)
  1109. "--no-daemon")
  1110. #:environment-variables
  1111. (list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
  1112. "/lib/NetworkManager/VPN")
  1113. ;; Override non-existent default users
  1114. "NM_OPENVPN_USER="
  1115. "NM_OPENVPN_GROUP=")))
  1116. (stop #~(make-kill-destructor))))))))
  1117. (define network-manager-service-type
  1118. (let
  1119. ((config->packages
  1120. (match-lambda
  1121. (($ <network-manager-configuration> network-manager _ vpn-plugins)
  1122. `(,network-manager ,@vpn-plugins)))))
  1123. (service-type
  1124. (name 'network-manager)
  1125. (extensions
  1126. (list (service-extension shepherd-root-service-type
  1127. network-manager-shepherd-service)
  1128. (service-extension dbus-root-service-type config->packages)
  1129. (service-extension polkit-service-type
  1130. (compose
  1131. list
  1132. network-manager-configuration-network-manager))
  1133. (service-extension account-service-type
  1134. network-manager-accounts)
  1135. (service-extension activation-service-type
  1136. network-manager-activation)
  1137. (service-extension session-environment-service-type
  1138. network-manager-environment)
  1139. ;; Add network-manager to the system profile.
  1140. (service-extension profile-service-type config->packages)))
  1141. (default-value (network-manager-configuration))
  1142. (description
  1143. "Run @uref{https://wiki.gnome.org/Projects/NetworkManager,
  1144. NetworkManager}, a network management daemon that aims to simplify wired and
  1145. wireless networking."))))
  1146. ;;;
  1147. ;;; Connman
  1148. ;;;
  1149. (define-record-type* <connman-configuration>
  1150. connman-configuration make-connman-configuration
  1151. connman-configuration?
  1152. (connman connman-configuration-connman
  1153. (default connman))
  1154. (disable-vpn? connman-configuration-disable-vpn?
  1155. (default #f)))
  1156. (define (connman-activation config)
  1157. (let ((disable-vpn? (connman-configuration-disable-vpn? config)))
  1158. (with-imported-modules '((guix build utils))
  1159. #~(begin
  1160. (use-modules (guix build utils))
  1161. (mkdir-p "/var/lib/connman/")
  1162. (unless #$disable-vpn?
  1163. (mkdir-p "/var/lib/connman-vpn/"))))))
  1164. (define (connman-shepherd-service config)
  1165. "Return a shepherd service for Connman"
  1166. (and
  1167. (connman-configuration? config)
  1168. (let ((connman (connman-configuration-connman config))
  1169. (disable-vpn? (connman-configuration-disable-vpn? config)))
  1170. (list (shepherd-service
  1171. (documentation "Run Connman")
  1172. (provision '(networking))
  1173. (requirement
  1174. '(user-processes dbus-system loopback wpa-supplicant))
  1175. (start #~(make-forkexec-constructor
  1176. (list (string-append #$connman
  1177. "/sbin/connmand")
  1178. "--nodaemon"
  1179. "--nodnsproxy"
  1180. #$@(if disable-vpn? '("--noplugin=vpn") '()))
  1181. ;; As connman(8) notes, when passing '-n', connman
  1182. ;; "directs log output to the controlling terminal in
  1183. ;; addition to syslog." Redirect stdout and stderr
  1184. ;; to avoid spamming the console (XXX: for some reason
  1185. ;; redirecting to /dev/null doesn't work.)
  1186. #:log-file "/var/log/connman.log"))
  1187. (stop #~(make-kill-destructor)))))))
  1188. (define connman-service-type
  1189. (let ((connman-package (compose list connman-configuration-connman)))
  1190. (service-type (name 'connman)
  1191. (extensions
  1192. (list (service-extension shepherd-root-service-type
  1193. connman-shepherd-service)
  1194. (service-extension polkit-service-type
  1195. connman-package)
  1196. (service-extension dbus-root-service-type
  1197. connman-package)
  1198. (service-extension activation-service-type
  1199. connman-activation)
  1200. ;; Add connman to the system profile.
  1201. (service-extension profile-service-type
  1202. connman-package)))
  1203. (default-value (connman-configuration))
  1204. (description
  1205. "Run @url{https://01.org/connman,Connman},
  1206. a network connection manager."))))
  1207. ;;;
  1208. ;;; Modem manager
  1209. ;;;
  1210. (define modem-manager-service-type
  1211. (let ((config->package
  1212. (match-lambda
  1213. (($ <modem-manager-configuration> modem-manager)
  1214. (list modem-manager)))))
  1215. (service-type (name 'modem-manager)
  1216. (extensions
  1217. (list (service-extension dbus-root-service-type
  1218. config->package)
  1219. (service-extension udev-service-type
  1220. config->package)
  1221. (service-extension polkit-service-type
  1222. config->package)))
  1223. (default-value (modem-manager-configuration))
  1224. (description
  1225. "Run @uref{https://wiki.gnome.org/Projects/ModemManager,
  1226. ModemManager}, a modem management daemon that aims to simplify dialup
  1227. networking."))))
  1228. ;;;
  1229. ;;; USB_ModeSwitch
  1230. ;;;
  1231. (define-record-type* <usb-modeswitch-configuration>
  1232. usb-modeswitch-configuration make-usb-modeswitch-configuration
  1233. usb-modeswitch-configuration?
  1234. (usb-modeswitch usb-modeswitch-configuration-usb-modeswitch
  1235. (default usb-modeswitch))
  1236. (usb-modeswitch-data usb-modeswitch-configuration-usb-modeswitch-data
  1237. (default usb-modeswitch-data))
  1238. (config-file usb-modeswitch-configuration-config-file
  1239. (default #~(string-append #$usb-modeswitch:dispatcher
  1240. "/etc/usb_modeswitch.conf"))))
  1241. (define (usb-modeswitch-sh usb-modeswitch config-file)
  1242. "Build a copy of usb_modeswitch.sh located in package USB-MODESWITCH,
  1243. modified to pass the CONFIG-FILE in its calls to usb_modeswitch_dispatcher,
  1244. and wrap it to actually find the dispatcher in USB-MODESWITCH. The script
  1245. will be run by USB_ModeSwitch’s udev rules file when a modeswitchable USB
  1246. device is detected."
  1247. (computed-file
  1248. "usb_modeswitch-sh"
  1249. (with-imported-modules '((guix build utils))
  1250. #~(begin
  1251. (use-modules (guix build utils))
  1252. (let ((cfg-param
  1253. #$(if config-file
  1254. #~(string-append " --config-file=" #$config-file)
  1255. "")))
  1256. (mkdir #$output)
  1257. (install-file (string-append #$usb-modeswitch:dispatcher
  1258. "/lib/udev/usb_modeswitch")
  1259. #$output)
  1260. ;; insert CFG-PARAM into usb_modeswitch_dispatcher command-lines
  1261. (substitute* (string-append #$output "/usb_modeswitch")
  1262. (("(exec usb_modeswitch_dispatcher .*)( 2>>)" _ left right)
  1263. (string-append left cfg-param right))
  1264. (("(exec usb_modeswitch_dispatcher .*)( &)" _ left right)
  1265. (string-append left cfg-param right)))
  1266. ;; wrap-program needs bash in PATH:
  1267. (putenv (string-append "PATH=" #$bash "/bin"))
  1268. (wrap-program (string-append #$output "/usb_modeswitch")
  1269. `("PATH" ":" = (,(string-append #$coreutils "/bin")
  1270. ,(string-append
  1271. #$usb-modeswitch:dispatcher
  1272. "/bin")))))))))
  1273. (define (usb-modeswitch-configuration->udev-rules config)
  1274. "Build a rules file for extending udev-service-type from the rules in the
  1275. usb-modeswitch package specified in CONFIG. The rules file will invoke
  1276. usb_modeswitch.sh from the usb-modeswitch package, modified to pass the right
  1277. config file."
  1278. (match config
  1279. (($ <usb-modeswitch-configuration> usb-modeswitch data config-file)
  1280. (computed-file
  1281. "usb_modeswitch.rules"
  1282. (with-imported-modules '((guix build utils))
  1283. #~(begin
  1284. (use-modules (guix build utils))
  1285. (let ((in (string-append #$data "/udev/40-usb_modeswitch.rules"))
  1286. (out (string-append #$output "/lib/udev/rules.d"))
  1287. (script #$(usb-modeswitch-sh usb-modeswitch config-file)))
  1288. (mkdir-p out)
  1289. (chdir out)
  1290. (install-file in out)
  1291. (substitute* "40-usb_modeswitch.rules"
  1292. (("PROGRAM=\"usb_modeswitch")
  1293. (string-append "PROGRAM=\"" script "/usb_modeswitch"))
  1294. (("RUN\\+=\"usb_modeswitch")
  1295. (string-append "RUN+=\"" script "/usb_modeswitch"))))))))))
  1296. (define usb-modeswitch-service-type
  1297. (service-type
  1298. (name 'usb-modeswitch)
  1299. (extensions
  1300. (list
  1301. (service-extension
  1302. udev-service-type
  1303. (lambda (config)
  1304. (let ((rules (usb-modeswitch-configuration->udev-rules config)))
  1305. (list rules))))))
  1306. (default-value (usb-modeswitch-configuration))
  1307. (description "Run @uref{http://www.draisberghof.de/usb_modeswitch/,
  1308. USB_ModeSwitch}, a mode switching tool for controlling USB devices with
  1309. multiple @dfn{modes}. When plugged in for the first time many USB
  1310. devices (primarily high-speed WAN modems) act like a flash storage containing
  1311. installers for Windows drivers. USB_ModeSwitch replays the sequence the
  1312. Windows drivers would send to switch their mode from storage to modem (or
  1313. whatever the thing is supposed to do).")))
  1314. ;;;
  1315. ;;; WPA supplicant
  1316. ;;;
  1317. (define-record-type* <wpa-supplicant-configuration>
  1318. wpa-supplicant-configuration make-wpa-supplicant-configuration
  1319. wpa-supplicant-configuration?
  1320. (wpa-supplicant wpa-supplicant-configuration-wpa-supplicant ;<package>
  1321. (default wpa-supplicant))
  1322. (requirement wpa-supplicant-configuration-requirement ;list of symbols
  1323. (default '(user-processes loopback syslogd)))
  1324. (pid-file wpa-supplicant-configuration-pid-file ;string
  1325. (default "/var/run/wpa_supplicant.pid"))
  1326. (dbus? wpa-supplicant-configuration-dbus? ;Boolean
  1327. (default #t))
  1328. (interface wpa-supplicant-configuration-interface ;#f | string
  1329. (default #f))
  1330. (config-file wpa-supplicant-configuration-config-file ;#f | <file-like>
  1331. (default #f))
  1332. (extra-options wpa-supplicant-configuration-extra-options ;list of strings
  1333. (default '())))
  1334. (define wpa-supplicant-shepherd-service
  1335. (match-lambda
  1336. (($ <wpa-supplicant-configuration> wpa-supplicant requirement pid-file dbus?
  1337. interface config-file extra-options)
  1338. (list (shepherd-service
  1339. (documentation "Run the WPA supplicant daemon")
  1340. (provision '(wpa-supplicant))
  1341. (requirement (if dbus?
  1342. (cons 'dbus-system requirement)
  1343. requirement))
  1344. (start #~(make-forkexec-constructor
  1345. (list (string-append #$wpa-supplicant
  1346. "/sbin/wpa_supplicant")
  1347. (string-append "-P" #$pid-file)
  1348. "-B" ;run in background
  1349. "-s" ;log to syslogd
  1350. #$@(if dbus?
  1351. #~("-u")
  1352. #~())
  1353. #$@(if interface
  1354. #~((string-append "-i" #$interface))
  1355. #~())
  1356. #$@(if config-file
  1357. #~((string-append "-c" #$config-file))
  1358. #~())
  1359. #$@extra-options)
  1360. #:pid-file #$pid-file))
  1361. (stop #~(make-kill-destructor)))))))
  1362. (define wpa-supplicant-service-type
  1363. (let ((config->package
  1364. (match-lambda
  1365. (($ <wpa-supplicant-configuration> wpa-supplicant)
  1366. (list wpa-supplicant)))))
  1367. (service-type (name 'wpa-supplicant)
  1368. (extensions
  1369. (list (service-extension shepherd-root-service-type
  1370. wpa-supplicant-shepherd-service)
  1371. (service-extension dbus-root-service-type config->package)
  1372. (service-extension profile-service-type config->package)))
  1373. (description "Run the WPA Supplicant daemon, a service that
  1374. implements authentication, key negotiation and more for wireless networks.")
  1375. (default-value (wpa-supplicant-configuration)))))
  1376. ;;;
  1377. ;;; Hostapd.
  1378. ;;;
  1379. (define-record-type* <hostapd-configuration>
  1380. hostapd-configuration make-hostapd-configuration
  1381. hostapd-configuration?
  1382. (package hostapd-configuration-package
  1383. (default hostapd))
  1384. (interface hostapd-configuration-interface ;string
  1385. (default "wlan0"))
  1386. (ssid hostapd-configuration-ssid) ;string
  1387. (broadcast-ssid? hostapd-configuration-broadcast-ssid? ;Boolean
  1388. (default #t))
  1389. (channel hostapd-configuration-channel ;integer
  1390. (default 1))
  1391. (driver hostapd-configuration-driver ;string
  1392. (default "nl80211"))
  1393. ;; See <https://w1.fi/cgit/hostap/plain/hostapd/hostapd.conf> for a list of
  1394. ;; additional options we could add.
  1395. (extra-settings hostapd-configuration-extra-settings ;string
  1396. (default "")))
  1397. (define (hostapd-configuration-file config)
  1398. "Return the configuration file for CONFIG, a <hostapd-configuration>."
  1399. (match-record config <hostapd-configuration>
  1400. (interface ssid broadcast-ssid? channel driver extra-settings)
  1401. (plain-file "hostapd.conf"
  1402. (string-append "\
  1403. # Generated from your Guix configuration.
  1404. interface=" interface "
  1405. ssid=" ssid "
  1406. ignore_broadcast_ssid=" (if broadcast-ssid? "0" "1") "
  1407. channel=" (number->string channel) "\n"
  1408. extra-settings "\n"))))
  1409. (define* (hostapd-shepherd-services config #:key (requirement '()))
  1410. "Return Shepherd services for hostapd."
  1411. (list (shepherd-service
  1412. (provision '(hostapd))
  1413. (requirement `(user-processes ,@requirement))
  1414. (documentation "Run the hostapd WiFi access point daemon.")
  1415. (start #~(make-forkexec-constructor
  1416. (list #$(file-append hostapd "/sbin/hostapd")
  1417. #$(hostapd-configuration-file config))
  1418. #:log-file "/var/log/hostapd.log"))
  1419. (stop #~(make-kill-destructor)))))
  1420. (define hostapd-service-type
  1421. (service-type
  1422. (name 'hostapd)
  1423. (extensions
  1424. (list (service-extension shepherd-root-service-type
  1425. hostapd-shepherd-services)))
  1426. (description
  1427. "Run the @uref{https://w1.fi/hostapd/, hostapd} daemon for Wi-Fi access
  1428. points and authentication servers.")))
  1429. (define (simulated-wifi-shepherd-services config)
  1430. "Return Shepherd services to run hostapd with CONFIG, a
  1431. <hostapd-configuration>, as well as services to set up WiFi hardware
  1432. simulation."
  1433. (append (hostapd-shepherd-services config
  1434. #:requirement
  1435. '(unblocked-wifi
  1436. kernel-module-loader))
  1437. (list (shepherd-service
  1438. (provision '(unblocked-wifi))
  1439. (requirement '(file-systems kernel-module-loader))
  1440. (documentation
  1441. "Unblock WiFi devices for use by mac80211_hwsim.")
  1442. (start #~(lambda _
  1443. (invoke #$(file-append util-linux "/sbin/rfkill")
  1444. "unblock" "0")
  1445. (invoke #$(file-append util-linux "/sbin/rfkill")
  1446. "unblock" "1")))
  1447. (one-shot? #t)))))
  1448. (define simulated-wifi-service-type
  1449. (service-type
  1450. (name 'simulated-wifi)
  1451. (extensions
  1452. (list (service-extension shepherd-root-service-type
  1453. simulated-wifi-shepherd-services)
  1454. (service-extension kernel-module-loader-service-type
  1455. (const '("mac80211_hwsim")))))
  1456. (default-value (hostapd-configuration
  1457. (interface "wlan1")
  1458. (ssid "Test Network")))
  1459. (description "Run hostapd to simulate WiFi connectivity.")))
  1460. ;;;
  1461. ;;; Open vSwitch
  1462. ;;;
  1463. (define-record-type* <openvswitch-configuration>
  1464. openvswitch-configuration make-openvswitch-configuration
  1465. openvswitch-configuration?
  1466. (package openvswitch-configuration-package
  1467. (default openvswitch)))
  1468. (define openvswitch-activation
  1469. (match-lambda
  1470. (($ <openvswitch-configuration> package)
  1471. (let ((ovsdb-tool (file-append package "/bin/ovsdb-tool")))
  1472. (with-imported-modules '((guix build utils))
  1473. #~(begin
  1474. (use-modules (guix build utils))
  1475. (mkdir-p "/var/run/openvswitch")
  1476. (mkdir-p "/var/lib/openvswitch")
  1477. (let ((conf.db "/var/lib/openvswitch/conf.db"))
  1478. (unless (file-exists? conf.db)
  1479. (system* #$ovsdb-tool "create" conf.db)))))))))
  1480. (define openvswitch-shepherd-service
  1481. (match-lambda
  1482. (($ <openvswitch-configuration> package)
  1483. (let ((ovsdb-server (file-append package "/sbin/ovsdb-server"))
  1484. (ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
  1485. (list
  1486. (shepherd-service
  1487. (provision '(ovsdb))
  1488. (documentation "Run the Open vSwitch database server.")
  1489. (start #~(make-forkexec-constructor
  1490. (list #$ovsdb-server "--pidfile"
  1491. "--remote=punix:/var/run/openvswitch/db.sock")
  1492. #:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
  1493. (stop #~(make-kill-destructor)))
  1494. (shepherd-service
  1495. (provision '(vswitchd))
  1496. (requirement '(ovsdb))
  1497. (documentation "Run the Open vSwitch daemon.")
  1498. (start #~(make-forkexec-constructor
  1499. (list #$ovs-vswitchd "--pidfile")
  1500. #:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
  1501. (stop #~(make-kill-destructor))))))))
  1502. (define openvswitch-service-type
  1503. (service-type
  1504. (name 'openvswitch)
  1505. (extensions
  1506. (list (service-extension activation-service-type
  1507. openvswitch-activation)
  1508. (service-extension profile-service-type
  1509. (compose list openvswitch-configuration-package))
  1510. (service-extension shepherd-root-service-type
  1511. openvswitch-shepherd-service)))
  1512. (description
  1513. "Run @uref{http://www.openvswitch.org, Open vSwitch}, a multilayer virtual
  1514. switch designed to enable massive network automation through programmatic
  1515. extension.")
  1516. (default-value (openvswitch-configuration))))
  1517. ;;;
  1518. ;;; iptables
  1519. ;;;
  1520. (define %iptables-accept-all-rules
  1521. (plain-file "iptables-accept-all.rules"
  1522. "*filter
  1523. :INPUT ACCEPT
  1524. :FORWARD ACCEPT
  1525. :OUTPUT ACCEPT
  1526. COMMIT
  1527. "))
  1528. (define-record-type* <iptables-configuration>
  1529. iptables-configuration make-iptables-configuration iptables-configuration?
  1530. (iptables iptables-configuration-iptables
  1531. (default iptables))
  1532. (ipv4-rules iptables-configuration-ipv4-rules
  1533. (default %iptables-accept-all-rules))
  1534. (ipv6-rules iptables-configuration-ipv6-rules
  1535. (default %iptables-accept-all-rules)))
  1536. (define iptables-shepherd-service
  1537. (match-lambda
  1538. (($ <iptables-configuration> iptables ipv4-rules ipv6-rules)
  1539. (let ((iptables-restore (file-append iptables "/sbin/iptables-restore"))
  1540. (ip6tables-restore (file-append iptables "/sbin/ip6tables-restore")))
  1541. (shepherd-service
  1542. (documentation "Packet filtering framework")
  1543. (provision '(iptables))
  1544. (start #~(lambda _
  1545. (invoke #$iptables-restore #$ipv4-rules)
  1546. (invoke #$ip6tables-restore #$ipv6-rules)))
  1547. (stop #~(lambda _
  1548. (invoke #$iptables-restore #$%iptables-accept-all-rules)
  1549. (invoke #$ip6tables-restore #$%iptables-accept-all-rules))))))))
  1550. (define iptables-service-type
  1551. (service-type
  1552. (name 'iptables)
  1553. (description
  1554. "Run @command{iptables-restore}, setting up the specified rules.")
  1555. (extensions
  1556. (list (service-extension shepherd-root-service-type
  1557. (compose list iptables-shepherd-service))))))
  1558. ;;;
  1559. ;;; nftables
  1560. ;;;
  1561. (define %default-nftables-ruleset
  1562. (plain-file "nftables.conf"
  1563. "# A simple and safe firewall
  1564. table inet filter {
  1565. chain input {
  1566. type filter hook input priority 0; policy drop;
  1567. # early drop of invalid connections
  1568. ct state invalid drop
  1569. # allow established/related connections
  1570. ct state { established, related } accept
  1571. # allow from loopback
  1572. iifname lo accept
  1573. # allow icmp
  1574. ip protocol icmp accept
  1575. ip6 nexthdr icmpv6 accept
  1576. # allow ssh
  1577. tcp dport ssh accept
  1578. # reject everything else
  1579. reject with icmpx type port-unreachable
  1580. }
  1581. chain forward {
  1582. type filter hook forward priority 0; policy drop;
  1583. }
  1584. chain output {
  1585. type filter hook output priority 0; policy accept;
  1586. }
  1587. }
  1588. "))
  1589. (define-record-type* <nftables-configuration>
  1590. nftables-configuration
  1591. make-nftables-configuration
  1592. nftables-configuration?
  1593. (package nftables-configuration-package
  1594. (default nftables))
  1595. (ruleset nftables-configuration-ruleset ; file-like object
  1596. (default %default-nftables-ruleset)))
  1597. (define nftables-shepherd-service
  1598. (match-lambda
  1599. (($ <nftables-configuration> package ruleset)
  1600. (let ((nft (file-append package "/sbin/nft")))
  1601. (shepherd-service
  1602. (documentation "Packet filtering and classification")
  1603. (provision '(nftables))
  1604. (start #~(lambda _
  1605. (invoke #$nft "--file" #$ruleset)))
  1606. (stop #~(lambda _
  1607. (invoke #$nft "flush" "ruleset"))))))))
  1608. (define nftables-service-type
  1609. (service-type
  1610. (name 'nftables)
  1611. (description
  1612. "Run @command{nft}, setting up the specified ruleset.")
  1613. (extensions
  1614. (list (service-extension shepherd-root-service-type
  1615. (compose list nftables-shepherd-service))
  1616. (service-extension profile-service-type
  1617. (compose list nftables-configuration-package))))
  1618. (default-value (nftables-configuration))))
  1619. ;;;
  1620. ;;; PageKite
  1621. ;;;
  1622. (define-record-type* <pagekite-configuration>
  1623. pagekite-configuration
  1624. make-pagekite-configuration
  1625. pagekite-configuration?
  1626. (package pagekite-configuration-package
  1627. (default pagekite))
  1628. (kitename pagekite-configuration-kitename
  1629. (default #f))
  1630. (kitesecret pagekite-configuration-kitesecret
  1631. (default #f))
  1632. (frontend pagekite-configuration-frontend
  1633. (default #f))
  1634. (kites pagekite-configuration-kites
  1635. (default '("http:@kitename:localhost:80:@kitesecret")))
  1636. (extra-file pagekite-configuration-extra-file
  1637. (default #f)))
  1638. (define (pagekite-configuration-file config)
  1639. (match-record config <pagekite-configuration>
  1640. (package kitename kitesecret frontend kites extra-file)
  1641. (mixed-text-file "pagekite.rc"
  1642. (if extra-file
  1643. (string-append "optfile = " extra-file "\n")
  1644. "")
  1645. (if kitename
  1646. (string-append "kitename = " kitename "\n")
  1647. "")
  1648. (if kitesecret
  1649. (string-append "kitesecret = " kitesecret "\n")
  1650. "")
  1651. (if frontend
  1652. (string-append "frontend = " frontend "\n")
  1653. "defaults\n")
  1654. (string-join (map (lambda (kite)
  1655. (string-append "service_on = " kite))
  1656. kites)
  1657. "\n"
  1658. 'suffix))))
  1659. (define (pagekite-shepherd-service config)
  1660. (match-record config <pagekite-configuration>
  1661. (package kitename kitesecret frontend kites extra-file)
  1662. (with-imported-modules (source-module-closure
  1663. '((gnu build shepherd)
  1664. (gnu system file-systems)))
  1665. (shepherd-service
  1666. (documentation "Run the PageKite service.")
  1667. (provision '(pagekite))
  1668. (requirement '(networking))
  1669. (modules '((gnu build shepherd)
  1670. (gnu system file-systems)))
  1671. (start #~(make-forkexec-constructor/container
  1672. (list #$(file-append package "/bin/pagekite")
  1673. "--clean"
  1674. "--nullui"
  1675. "--nocrashreport"
  1676. "--runas=pagekite:pagekite"
  1677. (string-append "--optfile="
  1678. #$(pagekite-configuration-file config)))
  1679. #:log-file "/var/log/pagekite.log"
  1680. #:mappings #$(if extra-file
  1681. #~(list (file-system-mapping
  1682. (source #$extra-file)
  1683. (target source)))
  1684. #~'())))
  1685. ;; SIGTERM doesn't always work for some reason.
  1686. (stop #~(make-kill-destructor SIGINT))))))
  1687. (define %pagekite-accounts
  1688. (list (user-group (name "pagekite") (system? #t))
  1689. (user-account
  1690. (name "pagekite")
  1691. (group "pagekite")
  1692. (system? #t)
  1693. (comment "PageKite user")
  1694. (home-directory "/var/empty")
  1695. (shell (file-append shadow "/sbin/nologin")))))
  1696. (define pagekite-service-type
  1697. (service-type
  1698. (name 'pagekite)
  1699. (default-value (pagekite-configuration))
  1700. (extensions
  1701. (list (service-extension shepherd-root-service-type
  1702. (compose list pagekite-shepherd-service))
  1703. (service-extension account-service-type
  1704. (const %pagekite-accounts))))
  1705. (description
  1706. "Run @url{https://pagekite.net/,PageKite}, a tunneling solution to make
  1707. local servers publicly accessible on the web, even behind NATs and firewalls.")))
  1708. ;;;
  1709. ;;; Yggdrasil
  1710. ;;;
  1711. (define-record-type* <yggdrasil-configuration>
  1712. yggdrasil-configuration
  1713. make-yggdrasil-configuration
  1714. yggdrasil-configuration?
  1715. (package yggdrasil-configuration-package
  1716. (default yggdrasil))
  1717. (json-config yggdrasil-configuration-json-config
  1718. (default '()))
  1719. (config-file yggdrasil-config-file
  1720. (default "/etc/yggdrasil-private.conf"))
  1721. (autoconf? yggdrasil-configuration-autoconf?
  1722. (default #f))
  1723. (log-level yggdrasil-configuration-log-level
  1724. (default 'info))
  1725. (log-to yggdrasil-configuration-log-to
  1726. (default 'stdout)))
  1727. (define (yggdrasil-configuration-file config)
  1728. (define (scm->yggdrasil-json x)
  1729. (define key-value?
  1730. dotted-list?)
  1731. (define (param->camel str)
  1732. (string-concatenate
  1733. (map
  1734. string-capitalize
  1735. (string-split str (cut eqv? <> #\-)))))
  1736. (cond
  1737. ((key-value? x)
  1738. (let ((k (car x))
  1739. (v (cdr x)))
  1740. (cons
  1741. (if (symbol? k)
  1742. (param->camel (symbol->string k))
  1743. k)
  1744. v)))
  1745. ((list? x) (map scm->yggdrasil-json x))
  1746. ((vector? x) (vector-map scm->yggdrasil-json x))
  1747. (else x)))
  1748. (computed-file
  1749. "yggdrasil.conf"
  1750. #~(call-with-output-file #$output
  1751. (lambda (port)
  1752. ;; it's HJSON, so comments are a-okay
  1753. (display "# Generated by yggdrasil-service\n" port)
  1754. (display #$(scm->json-string
  1755. (scm->yggdrasil-json
  1756. (yggdrasil-configuration-json-config config)))
  1757. port)))))
  1758. (define (yggdrasil-shepherd-service config)
  1759. "Return a <shepherd-service> for yggdrasil with CONFIG."
  1760. (define yggdrasil-command
  1761. #~(append
  1762. (list (string-append
  1763. #$(yggdrasil-configuration-package config)
  1764. "/bin/yggdrasil")
  1765. "-useconffile"
  1766. #$(yggdrasil-configuration-file config))
  1767. (if #$(yggdrasil-configuration-autoconf? config)
  1768. '("-autoconf")
  1769. '())
  1770. (let ((extraconf #$(yggdrasil-config-file config)))
  1771. (if extraconf
  1772. (list "-extraconffile" extraconf)
  1773. '()))
  1774. (list "-loglevel"
  1775. #$(symbol->string
  1776. (yggdrasil-configuration-log-level config))
  1777. "-logto"
  1778. #$(symbol->string
  1779. (yggdrasil-configuration-log-to config)))))
  1780. (list (shepherd-service
  1781. (documentation "Connect to the Yggdrasil mesh network")
  1782. (provision '(yggdrasil))
  1783. (requirement '(networking))
  1784. (start #~(make-forkexec-constructor
  1785. #$yggdrasil-command
  1786. #:log-file "/var/log/yggdrasil.log"
  1787. #:group "yggdrasil"))
  1788. (stop #~(make-kill-destructor)))))
  1789. (define %yggdrasil-accounts
  1790. (list (user-group (name "yggdrasil") (system? #t))))
  1791. (define yggdrasil-service-type
  1792. (service-type
  1793. (name 'yggdrasil)
  1794. (description
  1795. "Connect to the Yggdrasil mesh network.
  1796. See yggdrasil -genconf for config options.")
  1797. (extensions
  1798. (list (service-extension shepherd-root-service-type
  1799. yggdrasil-shepherd-service)
  1800. (service-extension account-service-type
  1801. (const %yggdrasil-accounts))
  1802. (service-extension profile-service-type
  1803. (compose list yggdrasil-configuration-package))))))
  1804. ;;;
  1805. ;;; IPFS
  1806. ;;;
  1807. (define-record-type* <ipfs-configuration>
  1808. ipfs-configuration
  1809. make-ipfs-configuration
  1810. ipfs-configuration?
  1811. (package ipfs-configuration-package
  1812. (default go-ipfs))
  1813. (gateway ipfs-configuration-gateway
  1814. (default "/ip4/127.0.0.1/tcp/8082"))
  1815. (api ipfs-configuration-api
  1816. (default "/ip4/127.0.0.1/tcp/5001")))
  1817. (define %ipfs-home "/var/lib/ipfs")
  1818. (define %ipfs-accounts
  1819. (list (user-account
  1820. (name "ipfs")
  1821. (group "ipfs")
  1822. (system? #t)
  1823. (comment "IPFS daemon user")
  1824. (home-directory "/var/lib/ipfs")
  1825. (shell (file-append shadow "/sbin/nologin")))
  1826. (user-group
  1827. (name "ipfs")
  1828. (system? #t))))
  1829. (define (ipfs-binary config)
  1830. (file-append (ipfs-configuration-package config) "/bin/ipfs"))
  1831. (define %ipfs-home-mapping
  1832. #~(file-system-mapping
  1833. (source #$%ipfs-home)
  1834. (target #$%ipfs-home)
  1835. (writable? #t)))
  1836. (define %ipfs-environment
  1837. #~(list #$(string-append "HOME=" %ipfs-home)))
  1838. (define (ipfs-shepherd-service config)
  1839. "Return a <shepherd-service> for IPFS with CONFIG."
  1840. (define ipfs-daemon-command
  1841. #~(list #$(ipfs-binary config) "daemon"))
  1842. (list
  1843. (with-imported-modules (source-module-closure
  1844. '((gnu build shepherd)
  1845. (gnu system file-systems)))
  1846. (shepherd-service
  1847. (provision '(ipfs))
  1848. ;; While IPFS is most useful when the machine is connected
  1849. ;; to the network, only loopback is required for starting
  1850. ;; the service.
  1851. (requirement '(loopback))
  1852. (documentation "Connect to the IPFS network")
  1853. (modules '((gnu build shepherd)
  1854. (gnu system file-systems)))
  1855. (start #~(make-forkexec-constructor/container
  1856. #$ipfs-daemon-command
  1857. #:namespaces '#$(fold delq %namespaces '(user net))
  1858. #:mappings (list #$%ipfs-home-mapping)
  1859. #:log-file "/var/log/ipfs.log"
  1860. #:user "ipfs"
  1861. #:group "ipfs"
  1862. #:environment-variables #$%ipfs-environment))
  1863. (stop #~(make-kill-destructor))))))
  1864. (define (%ipfs-activation config)
  1865. "Return an activation gexp for IPFS with CONFIG"
  1866. (define (ipfs-config-command setting value)
  1867. #~(#$(ipfs-binary config) "config" #$setting #$value))
  1868. (define (set-config!-gexp setting value)
  1869. #~(system* #$@(ipfs-config-command setting value)))
  1870. (define settings
  1871. `(("Addresses.API" ,(ipfs-configuration-api config))
  1872. ("Addresses.Gateway" ,(ipfs-configuration-gateway config))))
  1873. (define inner-gexp
  1874. #~(begin
  1875. (umask #o077)
  1876. ;; Create $HOME/.ipfs structure
  1877. (system* #$(ipfs-binary config) "init")
  1878. ;; Apply settings
  1879. #$@(map (cute apply set-config!-gexp <>) settings)))
  1880. (define inner-script
  1881. (program-file "ipfs-activation-inner" inner-gexp))
  1882. ;; Run ipfs init and ipfs config from a container,
  1883. ;; in case the IPFS daemon was compromised at some point
  1884. ;; and ~/.ipfs is now a symlink to somewhere outside
  1885. ;; %ipfs-home.
  1886. (define container-gexp
  1887. (with-extensions (list shepherd)
  1888. (with-imported-modules (source-module-closure
  1889. '((gnu build shepherd)
  1890. (gnu system file-systems)))
  1891. #~(begin
  1892. (use-modules (gnu build shepherd)
  1893. (gnu system file-systems))
  1894. (let* ((constructor
  1895. (make-forkexec-constructor/container
  1896. (list #$inner-script)
  1897. #:namespaces '#$(fold delq %namespaces '(user))
  1898. #:mappings (list #$%ipfs-home-mapping)
  1899. #:user "ipfs"
  1900. #:group "ipfs"
  1901. #:environment-variables #$%ipfs-environment))
  1902. (pid (constructor)))
  1903. (waitpid pid))))))
  1904. ;; The activation may happen from the initrd, which uses
  1905. ;; a statically-linked guile, while the guix container
  1906. ;; procedures require a working dynamic-link.
  1907. (define container-script
  1908. (program-file "ipfs-activation-container" container-gexp))
  1909. #~(system* #$container-script))
  1910. (define ipfs-service-type
  1911. (service-type
  1912. (name 'ipfs)
  1913. (extensions
  1914. (list (service-extension account-service-type
  1915. (const %ipfs-accounts))
  1916. (service-extension activation-service-type
  1917. %ipfs-activation)
  1918. (service-extension shepherd-root-service-type
  1919. ipfs-shepherd-service)))
  1920. (default-value (ipfs-configuration))
  1921. (description
  1922. "Run @command{ipfs daemon}, the reference implementation
  1923. of the IPFS peer-to-peer storage network.")))
  1924. ;;;
  1925. ;;; Keepalived
  1926. ;;;
  1927. (define-record-type* <keepalived-configuration>
  1928. keepalived-configuration make-keepalived-configuration
  1929. keepalived-configuration?
  1930. (keepalived keepalived-configuration-keepalived ;<package>
  1931. (default keepalived))
  1932. (config-file keepalived-configuration-config-file ;file-like
  1933. (default #f)))
  1934. (define keepalived-shepherd-service
  1935. (match-lambda
  1936. (($ <keepalived-configuration> keepalived config-file)
  1937. (list
  1938. (shepherd-service
  1939. (provision '(keepalived))
  1940. (documentation "Run keepalived.")
  1941. (requirement '(loopback))
  1942. (start #~(make-forkexec-constructor
  1943. (list (string-append #$keepalived "/sbin/keepalived")
  1944. "--dont-fork" "--log-console" "--log-detail"
  1945. "--pid=/var/run/keepalived.pid"
  1946. (string-append "--use-file=" #$config-file))
  1947. #:pid-file "/var/run/keepalived.pid"
  1948. #:log-file "/var/log/keepalived.log"))
  1949. (respawn? #f)
  1950. (stop #~(make-kill-destructor)))))))
  1951. (define keepalived-service-type
  1952. (service-type (name 'keepalived)
  1953. (extensions (list (service-extension shepherd-root-service-type
  1954. keepalived-shepherd-service)))
  1955. (description
  1956. "Run @uref{https://www.keepalived.org/, Keepalived}
  1957. routing software.")))
  1958. ;;; networking.scm ends here