From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp10.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms9.migadu.com with LMTPS id eMbaIvm2nWRM1QAASxT56A (envelope-from ) for ; Thu, 29 Jun 2023 18:53:13 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp10.migadu.com with LMTPS id EKLbIfm2nWSAGQEAG6o9tA (envelope-from ) for ; Thu, 29 Jun 2023 18:53:13 +0200 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 11B3F3BACD for ; Thu, 29 Jun 2023 18:53:13 +0200 (CEST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qEusn-0002qG-2k; Thu, 29 Jun 2023 12:52:37 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qEulS-0008Nw-Ql for guix-patches@gnu.org; Thu, 29 Jun 2023 12:45:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qEulS-0000fv-HI for guix-patches@gnu.org; Thu, 29 Jun 2023 12:45:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qEulR-0008Gu-Ph for guix-patches@gnu.org; Thu, 29 Jun 2023 12:45:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#64349] [PATH] Guix service for robust and flexible persistent ssh forwarding Resent-From: Maze Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 29 Jun 2023 16:45:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 64349 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 64349@debbugs.gnu.org X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.168805709631763 (code B ref -1); Thu, 29 Jun 2023 16:45:01 +0000 Received: (at submit) by debbugs.gnu.org; 29 Jun 2023 16:44:56 +0000 Received: from localhost ([127.0.0.1]:53944 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qEulJ-0008G8-Fk for submit@debbugs.gnu.org; Thu, 29 Jun 2023 12:44:56 -0400 Received: from lists.gnu.org ([209.51.188.17]:38646) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qEuJB-0007Xm-4A for submit@debbugs.gnu.org; Thu, 29 Jun 2023 12:15:51 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qEuJA-0008Nd-M9 for guix-patches@gnu.org; Thu, 29 Jun 2023 12:15:48 -0400 Received: from mx1.polytechnique.org ([129.104.30.34]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qEuJ5-0006g3-Rx for guix-patches@gnu.org; Thu, 29 Jun 2023 12:15:48 -0400 Received: from ubik (unknown [36.106.199.53]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ssl.polytechnique.org (Postfix) with ESMTPSA id BB538560690 for ; Thu, 29 Jun 2023 18:15:37 +0200 (CEST) From: Maze Date: Fri, 30 Jun 2023 00:15:26 +0800 Message-ID: <87352a4541.fsf@pkbd.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.2 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-AV-Checked: ClamAV using ClamSMTP at svoboda.polytechnique.org (Thu Jun 29 18:15:39 2023 +0200 (CEST)) Received-SPF: pass client-ip=129.104.30.34; envelope-from=SRS0=KlxY=CR=whispers-vpn.org=maze@bounces.m4x.org; helo=mx1.polytechnique.org X-Spam_score_int: -39 X-Spam_score: -4.0 X-Spam_bar: ---- X-Spam_report: (-4.0 / 5.0 requ) BAYES_00=-1.9, HEADER_FROM_DIFFERENT_DOMAINS=0.25, RCVD_IN_DNSWL_MED=-2.3, RCVD_IN_MSPIKE_H3=0.001, RCVD_IN_MSPIKE_WL=0.001, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-Mailman-Approved-At: Thu, 29 Jun 2023 12:44:48 -0400 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Mailman-Approved-At: Thu, 29 Jun 2023 12:52:34 -0400 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: guix-patches-bounces+larch=yhetil.org@gnu.org X-Migadu-Country: US X-Migadu-Flow: FLOW_IN ARC-Seal: i=1; s=key1; d=yhetil.org; t=1688057593; a=rsa-sha256; cv=none; b=gaVbA//OLydsw3A5+lbpZlgzuJYsloKxCgQ5GIiEehbrtqyvB5zbOloSQQr5qOjOISCK9r p3k0SxSvFOzYSnw7TYf5SxnSLRGAcvsUjPyIeNWZEdGQ+GFeTFbb01PyJneGZmeRit2qKv Fb024B3fRgMDAvB2wIRdvZvTvCZZ7uyrH79RP0CElMEd8QMES/V7NhqBG7ZzZkU862pIQv QC+tx38HUOPW8qGvizqPy4LUF46GOE4ozMX5J0bGLpD+Yv+Hqdkx0R7RCP/Yo0vuw1h3xG hiUDjmtJaG5GZYsWsCUjCbIbkLOuB/Nm2TLVhskf7l+iHpHTGL/fbP+Y5FWqPg== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1688057593; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:list-id:list-help: list-unsubscribe:list-subscribe:list-post; bh=JzxiKdP+F8wPCjXHlxMUXI78zRCWukgouz4jdYuM7gY=; b=dasUeR4W21P/6kFniBJv0jiifEJfd6tLfn5zOGW2ZKhA6RCPk5T6srlNLf+V04RDVUAyJE noM37hwYccCSeAp855vmiUVUX3hefbQ8HISO1/JwBCWsSiSgKMJtBu/8dc2wWdtdYwKZcj kUx66YyKSY5dFkL0gOe10dYE0bfnv+t1FZ2pfNBPGVNe7jfLCqDbK6sq1OVRUxMxGFEQfr 7lODHk8mY2cF8PHi769hgibMdIF4NtB4Z0/8Iy/0enwTRBpig55Ute3O5Y3O5lKDZe7ogi axrOmOninw22e0PGHa+ULGNsM2dUZ1Qgje9PBaNwnDkkp84zoQ+y0m1HRrgnVg== Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Scanner: scn0.migadu.com X-Migadu-Spam-Score: -4.26 X-Spam-Score: -4.26 X-Migadu-Queue-Id: 11B3F3BACD X-TUID: xp+PXQ8aY18s Hello Guix! I have written a Guix service module to daemonize various types of ssh forwardings. Basic uses should be very easy to configure. I am a beginner so you guys will probably laugh at my Scheme. But I have been using this for remote access to my computers and to daemonize socks proxies on localhost, I'll say it's pretty damned robust even when the network is extremely slow, and I think port [reverse] forwardings and dynamic forwardings are things that quite a few users like to have, even stand-alone.=20 Anyway, as the Guix manual recommends I'm just checking if you're interested to integrate part or all of this into the Guix mainline, or cannibalize for GNU in any way you see fit. Regardless of outcome, my goal now is to continue to build another layer on top to turn this into a full-blown VPN, as zeronconf as these things can get. But at the pace at which I'm going it's going to be 4 months at the very least before I have a semi-finished VPN for experimental use. The stand-alone forwardings of this patch, on the other hand, are working right here right now. CONFIGURING FOR ACCESS: * Your setup better be secure and never allow unauthenticated access to the remote server or the local client... If you don't have this in place, using this module could take you from bad to worse. * Don't forget to set GatewayPorts=3Dyes on the sshd if necessary for your case! For example in the sshd_config file. Chances are, you probably need it if you're looking to evade internet censorship, and it will make your life easier if you're looking for remote access to your home computer. * Rarely, and depending on your application it might also be necessary to enable gateway ports for the ssh client, there's a configuration switch for that in the record which does it on a connection basis. =20=20 * Currently, for the most default use the local ssh tries to get access to the remote sshd as root. But it's better to change from that default if you can, like in the basic examples below, unless you need to forward a priviledged port of the remote sshd. * By default access is to be granted by the remote sshd through a rsa private key at /root/id_rsa on the local client machine. You can change and it might work but you must feed it a file - no agent currently. See the record fields for details. As you're probably aware if you read this, when the sshd runs under Guix, a very nice facility is provided to take care of the public auth keys. * If you must use a password (don't!), the relevant fields of the configuration record should be self-explanatory.=20 =20=20 SERVICE RECORD BASIC EXAMPLES: On the client end, somewhat minimal configuration records might look something like this: * For a dynamic forward which can support the client end of a persistent socks proxy: (service persistent-ssh-service-type (ssh-connection-configuration (sshd-user "joe-chip") ; Default is root, better change if you can (sshd-host "1.2.3.4") ; Try with an IP address here at first (forwards (list (dynamic-forward-configuration (entry-port 1234)))))) ; you may want to change from defa= ult * For a port forwarding: (service persistent-ssh-service-type (ssh-connection-configuration (sshd-user "joe-chip") ; Default is root, better change if you can (sshd-host "1.2.3.4") ; Try with an IP address here at first (forwards (list (port-forward-configuration (entry-port 1234) ; you may want to change from default (exit-port 22)))))) ; default 22 here, could be what ; you need or not * For a reverse port forwarding: (service persistent-ssh-service-type (ssh-connection-configuration (sshd-user "joe-chip") ; Default is root, better change if you can (sshd-host "1.2.3.4") ; Try with an IP address here at first (forwards (list (reverse-port-forward-configuration (entry-port 1234) ; you may want to change from default (exit-port 22)))))) ; default 22 here, could be what ; you need or not Only the local client needs to use the facilities of the module in this patch, which means only the client must run Guix to enjoy the below service.=20 STATE OF THE ART: Features expected to work, from test script and/or my own daily use: * Dynamic forwards, port to port forwards or reverse forwards, tunnels. * Opening a forwarding while using a dynamic forward from the same guix service extended with this module as the entry point of its socks proxy. When using this underneath a tunnel forwarding supporting a VPN network, it's a very potent tool to workaround even the most advanced nation-state and megacorporation censorship technologies!.. brought to you by a dirty recourse to netcat-openbsd (not my original idea though, it's a nice little trick which has been floating around for some time). =20=20 * Being wrapped under sshpass. Boooh! As unrecommended as it may be, it can be a necessity sometimes such as with some commercial providers of the sshd end of a socks proxy... =20=20 * The resurrect and force-resurrect actions, actionnable from cron jobs. Nice when you spend a few days to a few weeks away from home and need remote access to your desktops and servers despite a dynamic IP and/or an uncooperative phone company. Available features that might work but are untested: * I recently added the feature that you can define multiple forwardings for a single ssh process. I have not begun testing any ssh connection with 2 or more forwardings, but there's a chance it already works because I extend the forwardings from basically just mapping a list in the configuration record. =20=20 * Socket-to-socket and port-to-socket [reverse] forwardings are also implemented but not yet tested. * There's still a home shepherd service type available. I used it some months ago then I stopped, it may or may not still work. * It can probably chain an in-practice-arbitrary number of socks proxies, but I have not tried yet. Suspected and known issue: * The log rotation apparently goes through a system reconfiguration if activated in the record, but then I think it does nothing. I probably did something incorrect, will look at it when I have time. * Auto-starting at boot is unreliable. One issue (maybe?) is I don't know how to really depend on the physical networking being fully established, but I'm not sure that's even the only problem. When I change nothing, I notice it's not deterministic at all. By the time I get a handle, I can start my failed auto-start connections with herd no problem. * In my own system configuration, I don't know why it seems that some forwardings accept a sshd host in the form of a resolvable hostname, others will only take an IP address. Not sure, it could be a subtlety with ssh or even a mistake in my system configurations file... But for the time being, I would recommend using IP addresses not hostnames if you trial this module. If it works, you can then shift to trying with a hostname and let me know if you experience issues. Missing: * I have not started to work on control masters. When one has many connections daemonized to the same remote host, there could (should?) be a specialized service type extended only to serve as a control master for multiple other forwarding services. It's probably not that easy to program correctly. * It only loads a private key directly from file, no ssh agent. I think it's probably quite easy to add. * I haven't even tried to make host knowing configurable the slightest. No one is there to input "yes" when it starts, so I just hard coded ssh command switches that should completely tame the dreaded "SOMEONE MAY BE DOING SOMETHING NASTY!" and its little friends. Still, in the event this module would start to have its small user base, I might kind of feel bad about this and something would preferably have to be done... if that can possibly be practical. =20=20 * I think it can only do point-to-point tunnels, that is to say tun devices. Ssh documentation says it also can do tap devices, what they call layer 2, which can support DHCP, but in trials I never could get it to spit out a working tap tunnel... By using ssh for the network side of the tunnel and tunctl or POSIX or whatever applicable system calls from a program for the host sides of the tunnel, maybe it's possible to do tap devices. It's hard, probably. * No documentation as of yet. The author also still has to learn how to write actual Texinfo docstrings for procedures, sorry about that. * I have a test script (not shared here) but it does not plug into the build system. Also, it deploys multiples VMs to test forwardings in situation, which means it can do some very strong testing but it's too heavy for a routine build. And the script does other things which are either crazy and/or very badly written. I could never have pulled this without my horrible shell script, but still, a simple script which plugs into the build system would be more desirable. --- gnu/services/ssh-tunneler.scm | 834 ++++++++++++++++++++++++++++++++++ 1 file changed, 834 insertions(+) create mode 100644 gnu/services/ssh-tunneler.scm diff --git a/gnu/services/ssh-tunneler.scm b/gnu/services/ssh-tunneler.scm new file mode 100644 index 0000000000..0163aa9e65 --- /dev/null +++ b/gnu/services/ssh-tunneler.scm @@ -0,0 +1,834 @@ +;;; Whispers --- Stealth VPN and ssh tunneler +;;; Copyright =C2=A9 2023 Maze +;;; +;;; This file is part of Whispers. +;;; +;;; Whispers is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Whispers is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Whispers. If not, see . + +(define-module (gnu services ssh-tunneler) + #:use-module (guix gexp) + #:use-module (guix records) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (gnu services admin) + #:use-module (gnu services mcron) + #:use-module (gnu packages base) + #:use-module (gnu packages admin) + #:use-module (gnu packages linux) + #:use-module (gnu packages ssh) + #:use-module (gnu home services) + #:use-module (gnu home services shepherd) + #:export (ssh-connection-configuration + make-ssh-connection-configuration + ssh-connection-configuration? + this-ssh-connection-configuration + ssh-forward-configuration + this-ssh-forward-configuration + ssh-forward-configuration? + make-ssh-forward-configuration + socks-proxy-configuration + this-socks-proxy-configuration + socks-proxy-configuration? + make-socks-proxy-configuration + dynamic-forward-configuration + port-forward-configuration + reverse-port-forward-configuration + tunnel-forward-configuration + persistent-ssh-service-type + home-persistent-ssh-service-type)) + +(define-record-type* + ssh-connection-configuration make-ssh-connection-configuration + ssh-connection-configuration? + this-ssh-connection-configuration + ;; A file-like object. + (shepherd-package ssh-connection-configuration-shepherd-package + (default shepherd)) + ;; A file-like object. + (ssh-package ssh-connection-configuration-ssh-package + (default openssh)) + ;; A file-like object. + (netcat-package ssh-connection-configuration-netcat-package + (default netcat-openbsd)) + ;; A file-like object. + (sshpass-package ssh-connection-configuration-sshpass-package + (default sshpass)) + ;; A file-like object. + (ineutils-package ssh-connection-configuration-inetutils-package + (default inetutils)) + ;; A file-like object. + (procps-package ssh-connection-configuration-procps-package + (default procps)) + ;; A guix record of type + (socks-proxy-config ssh-connection-configuration-socks-proxy-config + (default (socks-proxy-configuration))) + ;; A boolean value. + (id-rsa-file? ssh-connection-configuration-id-rsa-file? + (default #t)) + ;; A string. + (id-rsa-file ssh-connection-configuration-id-rsa-file + (default "/root/.ssh/id_rsa")) + ;; A boolean value. + (clear-password? ssh-connection-configuration-clear-password? + (default #f)) + ;; A string. + (sshd-user-password ssh-connection-configuration-sshd-user-password + (default "none")) + ;; A string. + (sshd-user ssh-connection-configuration-sshd-user + (default "root")) + ;; A string. + (sshd-host ssh-connection-configuration-sshd-host + (default "localhost")) + ;; An integer. + (sshd-port ssh-connection-configuration-sshd-port + (default 22)) + ;; A boolean value. + (gateway-ports? ssh-connection-configuration-gateway-ports? + (default #t)) + ;; A string. + (name-prefix ssh-connection-configuration-name-prefix + (default "ssh-forwards")) + ;; A boolean value + (suffix-name? ssh-connection-configuration-suffix-name? + (default #t)) + ;; A list of strings. + (special-options ssh-connection-configuration-special-options + (default (list))) + ;; A list of records. + (forwards ssh-connection-configuration-forwards + (default '())) + ;; A boolean value. + (exit-forward-failure? ssh-connection-configuration-exit-forward-failur= e? + (default #t)) + ;; An integer. + (connection-attempts ssh-connection-configuration-connection-attempts + (default 1)) + ;; A boolean value. + (local-command? ssh-connection-configuration-local-command? + (default (ssh-connection-configuration-pid-file? + this-ssh-connection-configuration)) + (thunked)) + ;; A list of strings + (extra-local-commands ssh-connection-configuration-extra-local-commands + (default '())) + ;; A boolean value. + (require-networking? ssh-connection-configuration-require-networking? + (default #t)) + ;; A list of symbols. + (extra-requires ssh-connection-configuration-extra-requires + (default '())) + ;; A boolean value. + (elogind? ssh-connection-configuration-elogind? + (default #f)) + ;; A boolean value. + (pid-file? ssh-connection-configuration-pid-file? + (default #t)) + ;; A boolean value. + (pid-folder-override? ssh-connection-configuration-pid-folder-override? + (default #f)) + ;; A string. + (pid-folder-override ssh-connection-configuration-pid-folder-override + (default "/var/run")) + ;; A boolean value. + (timeout-override? ssh-connection-configuration-timeout-override? + (default #f)) + ;; An integer. + (timeout-override ssh-connection-configuration-timeout-override + (default 5)) + ;; A boolean value. + (dedicated-log-file? ssh-connection-configuration-dedicated-log-file? + (default #f)) + ;; A boolean value. + (log-rotate? ssh-connection-configuration-log-rotate? + (default #f)) + ;; A boolean value. + (log-folder-override? ssh-connection-configuration-log-folder-override? + (default #f)) + ;; A string. + (log-folder-override ssh-connection-configuration-log-folder-override + (default "/var/run")) + ;; An integer between 0 and 3, both included. + (verbosity ssh-connection-configuration-verbosity + (default 0)) + ;; A boolean value. + (command? ssh-connection-configuration-command? + (default #f)) + ;; A string. + (command ssh-connection-configuration-command + (default '())) + ;; A quoted cron job time specification. + (resurrect-time-spec ssh-connection-configuration-resurrect-time-spec + (default ''(next-minute '(47)))) + ;; A boolean + (flat-resurrect? ssh-connection-configuration-flat-resurrect? + (default #f)) + ;; A quoted cron job time specification. + (force-resurrect-time-spec + ssh-connection-configuration-force-resurrect-time-spec + (default ''(next-hour '(3)))) + ;; A boolean + (flat-force-resurrect? ssh-connection-configuration-flat-force-resurrec= t? + (default #f)) + ;; A boolean value. + (%cron-resurrect? ssh-connection-configuration-cron-resurrect? + (default #f)) + ;; A boolean value. + (%cron-force-resurrect? ssh-connection-configuration-cron-force-resurrec= t? + (default #f)) + ;; A boolean value. + (%auto-start? ssh-connection-configuration-auto-start? + (default #t))) + +(define-record-type* + ssh-forward-configuration make-ssh-forward-configuration + ssh-forward-configuration? + this-ssh-forward-configuration + ;; A symbol which can be 'dynamic, 'port, 'reverse-port or 'tunnel + (forward-type ssh-forward-configuration-forward-type + (default 'dynamic)) + ;; A symbol which can be 'preset or 'any when the 'forward-type field + ;; is 'tunnel, and which can be 'port or 'socket otherwise. It is + ;; ignored when the 'forward-type field is 'dynamic. + (entry-type ssh-forward-configuration-entry-type + (default 'port)) + ;; A symbol which can be 'preset or 'any when the 'forward-type field + ;; is 'tunnel, and which can be 'port or 'socket otherwise. It is + ;; ignored when the 'forward-type field evaluates to 'dynamic. + (exit-type ssh-forward-configuration-exit-type + (default 'port)) + ;; An integer + (entry-port ssh-forward-configuration-entry-port + (default 8971)) + ;; An integer + (exit-port ssh-forward-configuration-exit-port + (default 22)) + ;; A string + (entry-socket ssh-forward-configuration-entry-socket + (default "")) + ;; A string + (exit-socket ssh-forward-configuration-exit-socket + (default "")) + ;; A string + (forward-host ssh-forward-configuration-exit-host + (default "localhost")) + ;; An integer + (entry-tun ssh-forward-configuration-entry-tun + (default 0)) + ;; An integer + (exit-tun ssh-forward-configuration-exit-tun + (default 0))) + +(define-record-type* + socks-proxy-configuration make-socks-proxy-configuration + socks-proxy-configuration? + this-socks-proxy-configuration + ;; A boolean value + (use-proxy? socks-proxy-configuration-use-proxy? + (default #f)) + ;; A boolean value + (extend? socks-proxy-configuration-extend? + (default (socks-proxy-configuration-use-proxy? + this-socks-proxy-configuration)) + (thunked)) + ;; An integer + (port socks-proxy-configuration-port + (default + (if + (socks-proxy-configuration-extend? + this-socks-proxy-configuration) + (ssh-forward-configuration-entry-port + (car + (ssh-connection-configuration-forwards + (socks-proxy-configuration-dynamic-forward + this-socks-proxy-configuration)))) + 8971)) + (thunked)) + ;; #f, or a guix record returned by a call to + ;; (ssh-connection-configuration + ;; (forwards (list (dynamic-forward-configuration ...))) + ;; ...) + (dynamic-forward socks-proxy-configuration-dynamic-forward + (default (if (socks-proxy-configuration-extend? + this-socks-proxy-configuration) + (dynamic-forward-configuration) + #f)) + (thunked))) + + +(define-syntax dynamic-forward-configuration + (syntax-rules () + ((_ fields ...) + (ssh-forward-configuration + (inherit + (ssh-forward-configuration)) + fields ...)))) + +(define-syntax port-forward-configuration + (syntax-rules () + ((_ fields ...) + (ssh-forward-configuration + (inherit + (ssh-forward-configuration (forward-type 'port) + (entry-port 6947))) + fields ...)))) + +(define-syntax reverse-port-forward-configuration + (syntax-rules () + ((_ fields ...) + (ssh-forward-configuration + (inherit + (ssh-forward-configuration (forward-type 'reverse-port) + (entry-port 6283))) + fields ...)))) + +(define-syntax tunnel-forward-configuration + (syntax-rules () + ((_ fields ...) + (ssh-forward-configuration + (inherit + (ssh-forward-configuration (forward-type 'tunnel) + (entry-type 'any) + (exit-type 'any))) + fields ...)))) + +(define (persistent-ssh-socks-port config) + "Returns an integer defining the localhost port that a persistent ssh +connection can use to establish itself through a socks proxy, +configurable by CONFIG, a record of the +type." + (socks-proxy-configuration-port + (ssh-connection-configuration-socks-proxy-config config))) + +(define (persistent-ssh-forward-stance forward-conf) + "Returns a string defining one of the forwarding stances of a +persistent ssh connection, configurable by FORWARD-CONF, a record of the + type." + (let* ((forward-type (ssh-forward-configuration-forward-type forward-con= f)) + (entry-type (ssh-forward-configuration-entry-type forward-conf)) + (exit-type (ssh-forward-configuration-exit-type forward-conf)) + (entry-port (ssh-forward-configuration-entry-port forward-conf)) + (entry-port-str (number->string entry-port)) + (exit-port (ssh-forward-configuration-exit-port forward-conf)) + (exit-port-str (number->string exit-port)) + (entry-socket (ssh-forward-configuration-entry-socket forward-con= f)) + (exit-socket (ssh-forward-configuration-exit-socket forward-conf)) + (exit-host (ssh-forward-configuration-exit-host forward-conf)) + (entry-tun (ssh-forward-configuration-entry-tun forward-conf)) + (entry-tun-str (number->string entry-tun)) + (exit-tun (ssh-forward-configuration-exit-tun forward-conf)) + (exit-tun-str (number->string exit-tun))) + (cond ((equal? forward-type 'dynamic) + (number->string entry-port)) + ((or (equal? forward-type 'port) + (equal? forward-type 'reverse-port)) + (cond ((equal? entry-type 'port) (string-append entry-port-str + ":" + exit-host + ":" + exit-port-str)) + ((equal? entry-type 'socket) (string-append entry-socket + ":" + exit-socket)) + (#t #f))) + ((equal? forward-type 'tunnel) + (string-append (cond ((equal? entry-type 'preset) entry-tun-str) + ((equal? entry-type 'any) "any") + (#t #f)) + ":" + (cond ((equal? exit-type 'preset) exit-tun-str) + ((equal? exit-type 'any) "any") + (#t #f)))) + (#t + #f)))) + +(define (persistent-ssh-forward-switch forward-conf) + "Returns a string defining one of the forwarding switches of a +persistent ssh connection, configurable by FORWARD-CONF, a record of the + type." + (let ((forward-type (ssh-forward-configuration-forward-type forward-conf= ))) + (cond ((equal? forward-type 'dynamic) "-D") + ((equal? forward-type 'port) "-L") + ((equal? forward-type 'reverse-port) "-R") + ((equal? forward-type 'tunnel) "-w") + (#t #f)))) + +(define (persistent-ssh-forward forward-conf) + "Returns a list of 2 strings containing the switch and stance of one of = the +forwardings of a persistent ssh connection, configurable by +FORWARD-CONF, a record of the type." + (list (persistent-ssh-forward-switch forward-conf) + (persistent-ssh-forward-stance forward-conf))) + +(define (persistent-ssh-name-suffix config) + "Returns a string defining the suffix part of the shepherd service +provision of the shepherd service daemonizing a persistent ssh +connection, configurable by CONFIG, a record of the + type." + (let* ((forwards (ssh-connection-configuration-forwards config)) + (typer ssh-forward-configuration-forward-type) + (typer-str (lambda (forward) + (symbol->string (typer forward)))) + (stancer persistent-ssh-forward-stance) + (socks-rec (ssh-connection-configuration-socks-proxy-config confi= g)) + (use-socks? (socks-proxy-configuration-use-proxy? socks-rec)) + (socks-port (socks-proxy-configuration-port socks-rec)) + (socks-port-str (number->string socks-port)) + (flat? (ssh-connection-configuration-flat-resurrect? config))) + (string-append "@" + (string-join (map (lambda (forward) + (string-append (typer-str forward) + "," + (stancer forward))) + forwards) + "_") + (if use-socks? + (string-append "@" + socks-port-str) + "")))) + +(define (persistent-ssh-name config) + "Returns a symbol defining the shpherd service provision of the +shepherd service daemonizing a persistent ssh connection, configurable +by CONFIG, a record of the type." + (string->symbol + (string-append (ssh-connection-configuration-name-prefix config) + (if (ssh-connection-configuration-suffix-name? config) + (persistent-ssh-name-suffix config) + "")))) + +(define (persistent-ssh-pid-folder config) + "Returns a string defining the path to the folder in which the pid +file of a persistent ssh connection service is stored by default, +configurable by CONFIG, a record of the +type." + (cond ((ssh-connection-configuration-pid-folder-override? config) + (ssh-connection-configuration-pid-folder-override config)) + ((ssh-connection-configuration-elogind? config) + (string-append "/run/user/" (number->string (getuid)))) + (else "/var/run"))) + +(define (persistent-ssh-pid-file-path config) + "Returns a string defining the path to the pid file of a persistent +ssh connection service, configurable by CONFIG, configurable by CONFIG, +a record of the type." + (string-append (persistent-ssh-pid-folder config) + "/" + (symbol->string (persistent-ssh-name config)) + ".pid")) + +(define (persistent-ssh-log-folder config) + "Returns a string defining the path to the folder in which the log +file of a persistent ssh connection service is stored by default, +configurable by CONFIG, a record of the +type." + (cond ((ssh-connection-configuration-log-folder-override? config) + (ssh-connection-configuration-log-folder-override config)) + ((ssh-connection-configuration-elogind? config) + (string-append "/run/user/" (number->string (getuid)))) + (else "/var/run"))) + +(define (persistent-ssh-log-file-path config) + "Returns a string defining the path to the log file of a persistent +ssh connection service, configurable by CONFIG, a record of the + type." + (string-append (persistent-ssh-log-folder config) + "/" + (symbol->string (persistent-ssh-name config)) + ".log")) + +(define (persistent-ssh-local-command config) + "Returns a string defining command executed locally after the forwards +of a persistent ssh connection service have been succesfully created, +configurable by CONFIG, a record of the +type." + (let ((procps-package (ssh-connection-configuration-procps-package confi= g)) + (clear-password? (ssh-connection-configuration-clear-password? + config)) + (extra-local-commands + (ssh-connection-configuration-extra-local-commands + config))) + (append (list (file-append procps-package + "/bin/ps") + " --no-header --pid $PPID -o " + (if clear-password? + "ppid" + "pid") + " > " + (persistent-ssh-pid-file-path config)) + (map (lambda (command) + (string-append " && " + command)) + extra-local-commands)))) + +(define (persistent-ssh-requires config) + "Returns a list of symbols defining the other services required as +dependencies by the shepherd service of a persistent ssh connection, +configurable by CONFIG, a record of the +type." + (let* ((req-net? (ssh-connection-configuration-require-networking? confi= g)) + (extra-reqs (ssh-connection-configuration-extra-requires config)) + (socks-rec (ssh-connection-configuration-socks-proxy-config confi= g)) + (inferior? (socks-proxy-configuration-extend? socks-rec)) + (inferior-cnf (socks-proxy-configuration-dynamic-forward socks-re= c)) + (use-socks? (socks-proxy-configuration-use-proxy? socks-rec)) + (socks-port (socks-proxy-configuration-port socks-rec)) + (socks-port-str (number->string socks-port)) + (flat? (ssh-connection-configuration-flat-force-resurrect? config= ))) + (append + (if req-net? + (list 'networking) + (list)) + extra-reqs + (if inferior? + (list (persistent-ssh-name inferior-cnf)) + (if use-socks? + (list (string->symbol + ;; FIXME: this just assumes a possible + ;; default name, not always true and not + ;; even the only possible default. + (string-append "ssh-forwards@dynamic," + (number->string socks-port)))) + (list)))))) + +(define (persistent-ssh-timeout config) + "Returns an integer setting the pid file timout of the shepherd +service daemonizing a persistent ssh connection, configurable by CONFIG, +a record of the type." + (if (ssh-connection-configuration-timeout-override? config) + (ssh-connection-configuration-timeout-override config) + #~(+ #$(ssh-connection-configuration-connection-attempts config) + (default-pid-file-timeout)))) + +(define (persistent-ssh-constructor-gexp config) + "Returns G-exp to a procedure starting the ssh client process of a +persistent ssh connection, configurable by CONFIG, a record of the + type." + (let* ((sshpass-pkg (ssh-connection-configuration-sshpass-package config= )) + (password (ssh-connection-configuration-sshd-user-password config= )) + (ssh-pkg (ssh-connection-configuration-ssh-package config)) + (netcat-pkg (ssh-connection-configuration-netcat-package config)) + (verbosity (ssh-connection-configuration-verbosity config)) + (eff? (ssh-connection-configuration-exit-forward-failure? config)) + (tries (ssh-connection-configuration-connection-attempts config)) + (tries-str (number->string tries)) + (local-com? (ssh-connection-configuration-local-command? config)) + (local-com (persistent-ssh-local-command config)) + (gateway? (ssh-connection-configuration-gateway-ports? config)) + (socks-rec (ssh-connection-configuration-socks-proxy-config confi= g)) + (use-socks? (socks-proxy-configuration-use-proxy? socks-rec)) + (socks-port (socks-proxy-configuration-port socks-rec)) + (socks-port-str (number->string socks-port)) + (command? (ssh-connection-configuration-command? config)) + (command (ssh-connection-configuration-command config)) + (forwards (ssh-connection-configuration-forwards config)) + (sshd-port (ssh-connection-configuration-sshd-port config)) + (sshd-port-str (number->string sshd-port)) + (id-rsa? (ssh-connection-configuration-id-rsa-file? config)) + (id-rsa (ssh-connection-configuration-id-rsa-file config)) + (sshd-user (ssh-connection-configuration-sshd-user config)) + (sshd-host (ssh-connection-configuration-sshd-host config)) + (dlf? (ssh-connection-configuration-dedicated-log-file? config)) + (log-file (persistent-ssh-log-file-path config)) + (pid-file? (ssh-connection-configuration-pid-file? config)) + (pid-file (persistent-ssh-pid-file-path config)) + (timeout (persistent-ssh-timeout config)) + (special-opt (ssh-connection-configuration-special-options config= ))) + #~(make-forkexec-constructor + (append #$(if (ssh-connection-configuration-clear-password? config) + #~(list #$(file-append sshpass-pkg "/bin/sshpass") + "-p" + #$password) + #~(list)) + (list #$(file-append ssh-pkg "/bin/ssh") + "-o" + "TCPKeepAlive=3Dno" + "-o" + "ServerAliveInterval=3D30" + "-o" + "ServerAliveCountMax=3D6" + "-o" + "UserKnownHostsFile=3D/dev/null" + "-o" + "StrictHostKeyChecking=3Dno" + ;; "-o" + ;; "Tunnel=3Dpoint-to-point" + "-o" + (string-append "ExitOnForwardFailure=3D" + #$(if eff? + "yes" + "no")) + "-o" + (string-append "ConnectionAttempts=3D" + #$tries-str)) + #$(if local-com? + #~(list "-o" + "PermitLocalCommand=3Dyes" + "-o" + (apply string-append + (append (list "LocalCommand=3D") + #$(append (list 'list) + local-com)))) + #~(list)) + #$(if gateway? + #~(list "-o" + "GatewayPorts=3Dyes") + #~(list)) + #$(if use-socks? + #~(list "-o" + (string-append "ProxyCommand=3D" + #$netcat-pkg + "/bin/nc" + " -X 5 -x localhost:" + #$socks-port-str + " %h %p")) + #~(list)) + #$(append (list 'list) + special-opt) + (list "-p" + #$sshd-port-str) + #$(if id-rsa? + #~(list "-i" + #$id-rsa) + #~(list)) + #$(cond ((=3D verbosity 0) #~(list)) + ((=3D verbosity 1) #~(list "-v")) + ((=3D verbosity 2) #~(list "-v" "-v")) + ((=3D verbosity 3) #~(list "-v" "-v" "-v")) + (#t #f)) + #$(if command? + #~(list) + #~(list "-N")) + #$(append (list 'list) + (apply append + (map persistent-ssh-forward + forwards))) + (list (string-append #$sshd-user + "@" + #$sshd-host)) + #$(if command? + #~(list #$command) + #~(list))) + #:log-file + #$(if dlf? + log-file + #f) + #:pid-file + #$(if pid-file? + pid-file + #f) + #:pid-file-timeout + #$timeout))) + +(define (persistent-ssh-resurrect-action config) + "Returns a G-exp to a procedure used as the procedure of the +'resurrect action of the shepherd service supporting a persistent ssh +connection , configurable by CONFIG, a record of the + type." + (let* ((name (persistent-ssh-name config)) + (socks-rec (ssh-connection-configuration-socks-proxy-config confi= g)) + (inferior? (socks-proxy-configuration-extend? socks-rec)) + (inferior-cnf (socks-proxy-configuration-dynamic-forward socks-re= c)) + (use-socks? (socks-proxy-configuration-use-proxy? socks-rec)) + (socks-port (socks-proxy-configuration-port socks-rec)) + (socks-port-str (number->string socks-port)) + (flat? (ssh-connection-configuration-flat-resurrect? config))) + #~(lambda (running) + (unless (service-running? (lookup-service '#$name)) + (perform-service-action (lookup-service '#$name) + 'enable) + (unless (or #$flat? + (and (not #$inferior?) + (not #$use-socks?))) + (let ((inferior-name + '#$(if inferior? + (persistent-ssh-name inferior-cnf) + (if use-socks? + (string->symbol + ;; FIXME: this just assumes a possible + ;; default name, not always true and not + ;; even the only possible default. + (string-append "ssh-forwards@dynamic," + socks-port-str)) + 'not-a-service)))) + (perform-service-action (lookup-service inferior-name) + 'resurrect))) + (start-service (lookup-service '#$name))) + #t))) + +(define (persistent-ssh-force-resurrect-action config) + "Returns a G-exp to a procedure used as the procedure of the +'force-resurrect action of the shepherd service supporting a persistent +ssh connection , configurable by CONFIG, a record of the + type." + (let* ((name (persistent-ssh-name config)) + (socks-rec (ssh-connection-configuration-socks-proxy-config confi= g)) + (inferior? (socks-proxy-configuration-extend? socks-rec)) + (inferior-cnf (socks-proxy-configuration-dynamic-forward socks-re= c)) + (use-socks? (socks-proxy-configuration-use-proxy? socks-rec)) + (socks-port (socks-proxy-configuration-port socks-rec)) + (socks-port-str (number->string socks-port)) + (flat? (ssh-connection-configuration-flat-force-resurrect? config= ))) + #~(lambda (running) + (perform-service-action (lookup-service '#$name) + 'enable) + (stop-service (lookup-service '#$name)) + (unless (or #$flat? + (and (not #$inferior?) + (not #$use-socks?))) + (let ((inferior-name + '#$(if inferior? + (persistent-ssh-name inferior-cnf) + (if use-socks? + (string->symbol + ;; FIXME: this just assumes a possible + ;; default name, not always true and not + ;; even the only possible default. + (string-append "ssh-forwards@dynamic," + socks-port-str)) + 'not-a-service)))) + (perform-service-action (lookup-service inferior-name) + 'force-resurrect))) + (start-service (lookup-service '#$name)) + #t))) + +(define (persistent-ssh-shepherd-services config) + "Returns a list of shepherd services handling a ssh client daemon +connection, configured by CONFIG, a record of the + type." + (let* ((name (persistent-ssh-name config)) + (socks-rec (ssh-connection-configuration-socks-proxy-config confi= g)) + (inferior? (socks-proxy-configuration-extend? socks-rec)) + (inferior-cnf (socks-proxy-configuration-dynamic-forward socks-re= c)) + (use-socks? (socks-proxy-configuration-use-proxy? socks-rec)) + (socks-port (socks-proxy-configuration-port socks-rec)) + (socks-port-str (number->string socks-port)) + (reqs (persistent-ssh-requires config)) + (constructor-gexp (persistent-ssh-constructor-gexp config)) + (res-gexp (persistent-ssh-resurrect-action config)) + (force-res-gexp (persistent-ssh-force-resurrect-action config)) + (auto-start? (ssh-connection-configuration-auto-start? config))) + (append + (if inferior? + (persistent-ssh-shepherd-services inferior-cnf) + (list)) + (list + (shepherd-service + (documentation "Persistent ssh client connection") + (provision `(,name)) + (requirement reqs) + (start constructor-gexp) + (stop #~(make-kill-destructor)) + (actions + (list + (shepherd-action (name 'resurrect) + (documentation + "Resurrect this connection and its +inferiors-proxies if they are stopped or disabled by the Shepherd.") + (procedure res-gexp)) + (shepherd-action (name 'force-resurrect) + (documentation "Enable, stop and restart this +connection and its inferior-proxies , regardless of their current +status.") + (procedure force-res-gexp)))) + (auto-start? auto-start?)))))) + +(define (persistent-ssh-cron-jobs config) + "Returns a list of cron job specifications to extend the mcron service +with scheduled resurrection actions on the persistent ssh connection +port forwards configured by CONFIG, a record of the + type." + (append + (if (ssh-connection-configuration-cron-resurrect? config) + (list + #~(job #$(ssh-connection-configuration-resurrect-time-spec config) + (lambda () + (execl + (string-append + #$(ssh-connection-configuration-shepherd-package config) + "/bin/herd") + "herd" + "resurrect" + #$(symbol->string (persistent-ssh-name config)))) + (string-append + "resurrect " + #$(symbol->string (persistent-ssh-name config))))) + (list)) + (if (ssh-connection-configuration-cron-force-resurrect? config) + (list + #~(job #$(ssh-connection-configuration-force-resurrect-time-spec + config) + (lambda() + (execl + (string-append + #$(ssh-connection-configuration-shepherd-package config) + "/bin/herd") + "herd" + "force-resurrect" + #$(symbol->string (persistent-ssh-name config)))) + (string-append + "force-resurrect " + #$(symbol->string (persistent-ssh-name config))))) + (list)))) + +(define (persistent-ssh-log-rotation config) + "Returns a list of log-rotation records specifying how to rotate the +logs of a persistent ssh connection configurable by CONFIG, a record of +the type." + (if (and (ssh-connection-configuration-dedicated-log-file? config) + (ssh-connection-configuration-log-rotate? config)) + (list + (log-rotation (frequency 'daily) + (files `(,(persistent-ssh-log-file-path config))))) + (list))) + +(define persistent-ssh-service-type + (service-type + (name 'persistent-ssh) + (description "Persistent ssh connection service") + (extensions + (list (service-extension shepherd-root-service-type + persistent-ssh-shepherd-services) + (service-extension mcron-service-type + persistent-ssh-cron-jobs) + (service-extension rottlog-service-type + persistent-ssh-log-rotation) + (service-extension + profile-service-type + (lambda (config) + (list + (ssh-connection-configuration-ssh-package config) + (ssh-connection-configuration-netcat-package config) + (ssh-connection-configuration-sshpass-package config) + (ssh-connection-configuration-procps-package config) + (ssh-connection-configuration-inetutils-package config)))))) + (default-value (ssh-connection-configuration)))) + +(define home-persistent-ssh-service-type + (service-type + (name 'persistent-ssh) + (description "Persistent ssh connection normal user service") + (extensions + (list (service-extension home-shepherd-service-type + persistent-ssh-shepherd-services) + (service-extension + home-profile-service-type + (lambda (config) + (list + (ssh-connection-configuration-ssh-package config) + (ssh-connection-configuration-netcat-package config) + (ssh-connection-configuration-sshpass-package config) + (ssh-connection-configuration-procps-package config) + (ssh-connection-configuration-inetutils-package config)))))) + (default-value (ssh-connection-configuration)))) --=20 2.40.1