Received: (at 64349) by debbugs.gnu.org; 12 Oct 2023 15:55:13 +0000 From debbugs-submit-bounces <at> debbugs.gnu.org Thu Oct 12 11:55:12 2023 Received: from localhost ([127.0.0.1]:44181 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>) id 1qqy1n-0007oS-OH for submit <at> debbugs.gnu.org; Thu, 12 Oct 2023 11:55:12 -0400 Received: from mx1.polytechnique.org ([129.104.30.34]:58695) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <SRS0=wrRY=F2=pkbd.org=runciter@HIDDEN>) id 1qqwjz-0004gH-Nk for 64349 <at> debbugs.gnu.org; Thu, 12 Oct 2023 10:32:46 -0400 Received: from ubik (unknown [106.47.200.210]) (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 E6B9D5647BE; Thu, 12 Oct 2023 16:32:16 +0200 (CEST) From: Runciter <runciter@HIDDEN> To: Bruno Victal <mirai@HIDDEN> Subject: Re: [bug#64349] [PATH] Guix service for robust and flexible persistent ssh forwarding In-Reply-To: <54efe1c6-6a81-497d-8b8b-0b499cfc2acb@HIDDEN> (Bruno Victal's message of "Tue, 10 Oct 2023 15:33:16 +0100") References: <87352a4541.fsf@HIDDEN> <54efe1c6-6a81-497d-8b8b-0b499cfc2acb@HIDDEN> Date: Thu, 12 Oct 2023 22:32:09 +0800 Message-ID: <87cyxj7vyu.fsf@HIDDEN> User-Agent: Gnus/5.13 (Gnus v5.13) 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 Oct 12 16:32:19 2023 +0200 (CEST)) X-Spam-Flag: No, tests=bogofilter, spamicity=0.000146, queueID=9005356478C X-Spam-Score: -2.1 (--) X-Debbugs-Envelope-To: 64349 X-Mailman-Approved-At: Thu, 12 Oct 2023 11:49:55 -0400 Cc: Maze <maze@HIDDEN>, 64349 <at> debbugs.gnu.org X-BeenThere: debbugs-submit <at> debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: <debbugs-submit.debbugs.gnu.org> List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe> List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/> List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org> List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help> List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe> Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org> X-Spam-Score: -3.1 (---) Bruno Victal <mirai@HIDDEN> writes: Hello, > Hi, > >> Missing: >>=20 >> * 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. >>=20 >> * It only loads a private key directly from file, no ssh agent. I think >> it's probably quite easy to add. >>=20 >> * 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=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. >>=20 >> * No documentation as of yet. The author also still has to learn how to >> write actual Texinfo docstrings for procedures, sorry about that. > > Any updates regarding these items? No update as of yet on any of these items. I've been working on a VPN on top of the ssh tunneler. For which I have obtained basic functionality, but it's still not quite ready even for my personal use. While I'm gradually improving the VPN I'm reluctant to add features to the underlying ssh tunneler services. Still, I can focus on documenting the services I submitted right now, and make clean docstrings for the procedures. > >> * 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. > > Can you adapt it or write a test suite for this service? (see gnu/tests/= =E2=80=A6 > for inspiration) > It makes it easier for everyone to test/review and maintain this addition. There's facilities that are used in the test suite of gdm to create a "marionette" operating system, probably this is what I should look into. So I'll stop working on my VPN for a little while and do 2 things: * Document the ssh-tunneler.scm service file which I previously submitted. * Try to create a scheme test suite for the services in ssh-tunneler.scm. I have to learn a few things to do this. Hopefully I can get back to you at the end of this month with a submission.
guix-patches@HIDDEN:bug#64349; Package guix-patches.
Full text available.Bruno Victal <mirai@HIDDEN>
to control <at> debbugs.gnu.org.
Full text available.Bruno Victal <mirai@HIDDEN>
to control <at> debbugs.gnu.org.
Full text available.Received: (at 64349) by debbugs.gnu.org; 10 Oct 2023 14:33:43 +0000 From debbugs-submit-bounces <at> debbugs.gnu.org Tue Oct 10 10:33:43 2023 Received: from localhost ([127.0.0.1]:36691 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>) id 1qqDnq-0000zj-Tr for submit <at> debbugs.gnu.org; Tue, 10 Oct 2023 10:33:43 -0400 Received: from smtpmciv3.myservices.hosting ([185.26.107.239]:50400) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <mirai@HIDDEN>) id 1qqDno-0000zW-He for 64349 <at> debbugs.gnu.org; Tue, 10 Oct 2023 10:33:41 -0400 Received: from mail1.netim.hosting (unknown [185.26.106.173]) by smtpmciv3.myservices.hosting (Postfix) with ESMTP id E3CCF20387; Tue, 10 Oct 2023 16:33:17 +0200 (CEST) Received: from localhost (localhost [127.0.0.1]) by mail1.netim.hosting (Postfix) with ESMTP id 64FFC8009E; Tue, 10 Oct 2023 16:33:17 +0200 (CEST) X-Virus-Scanned: Debian amavisd-new at mail1.netim.hosting Received: from mail1.netim.hosting ([127.0.0.1]) by localhost (mail1-2.netim.hosting [127.0.0.1]) (amavisd-new, port 10026) with ESMTP id qcFx8qaeY-Zo; Tue, 10 Oct 2023 16:33:17 +0200 (CEST) Received: from [192.168.1.116] (unknown [10.192.1.83]) (Authenticated sender: lumen@HIDDEN) by mail1.netim.hosting (Postfix) with ESMTPSA id CC7E88009C; Tue, 10 Oct 2023 16:33:16 +0200 (CEST) Message-ID: <54efe1c6-6a81-497d-8b8b-0b499cfc2acb@HIDDEN> Date: Tue, 10 Oct 2023 15:33:16 +0100 MIME-Version: 1.0 User-Agent: Mozilla Thunderbird Subject: Re: [bug#64349] [PATH] Guix service for robust and flexible persistent ssh forwarding To: Maze <maze@HIDDEN> References: <87352a4541.fsf@HIDDEN> Content-Language: en-US From: Bruno Victal <mirai@HIDDEN> In-Reply-To: <87352a4541.fsf@HIDDEN> Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 64349 Cc: 64349 <at> debbugs.gnu.org X-BeenThere: debbugs-submit <at> debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: <debbugs-submit.debbugs.gnu.org> List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe> List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/> List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org> List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help> List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe> Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org> X-Spam-Score: -1.0 (-) Hi, > 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. > > * 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. Any updates regarding these items? > * 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. Can you adapt it or write a test suite for this service? (see gnu/tests/… for inspiration) It makes it easier for everyone to test/review and maintain this addition. -- Furthermore, I consider that nonfree software must be eradicated. Cheers, Bruno.
guix-patches@HIDDEN:bug#64349; Package guix-patches.
Full text available.
Received: (at submit) by debbugs.gnu.org; 29 Jun 2023 16:44:56 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Thu Jun 29 12:44:56 2023
Received: from localhost ([127.0.0.1]:53944 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1qEulJ-0008G8-Fk
for submit <at> 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 <SRS0=KlxY=CR=whispers-vpn.org=maze@HIDDEN>)
id 1qEuJB-0007Xm-4A
for submit <at> 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 <SRS0=KlxY=CR=whispers-vpn.org=maze@HIDDEN>)
id 1qEuJA-0008Nd-M9
for guix-patches@HIDDEN; 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 <SRS0=KlxY=CR=whispers-vpn.org=maze@HIDDEN>)
id 1qEuJ5-0006g3-Rx
for guix-patches@HIDDEN; 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 <guix-patches@HIDDEN>; Thu, 29 Jun 2023 18:15:37 +0200 (CEST)
From: Maze <maze@HIDDEN>
To: guix-patches@HIDDEN
Subject: [PATH] Guix service for robust and flexible persistent ssh forwarding
Date: Fri, 30 Jun 2023 00:15:26 +0800
Message-ID: <87352a4541.fsf@HIDDEN>
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))
X-Spam-Flag: No, tests=bogofilter, spamicity=0.005010, queueID=28A1C5606A4
Received-SPF: pass client-ip=129.104.30.34;
envelope-from=SRS0=KlxY=CR=whispers-vpn.org=maze@HIDDEN;
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-Spam-Score: -1.1 (-)
X-Debbugs-Envelope-To: submit
X-Mailman-Approved-At: Thu, 29 Jun 2023 12:44:48 -0400
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -2.1 (--)
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 <maze@HIDDEN>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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>
+ 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-configuration>
+ (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 <ssh-forward-configuration> 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>
+ 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>
+ 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 <ssh-connection-configuration>
+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
+<ssh-forward-configuration> 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
+<ssh-forward-configuration> 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 <ssh-forward-configuration> 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
+<ssh-connection-configuration> 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 <ssh-connection-configuration> 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 <ssh-connection-configuration>
+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 <ssh-connection-configuration> 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 <ssh-connection-configuration>
+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
+<ssh-connection-configuration> 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 <ssh-connection-configuration>
+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 <ssh-connection-configuration>
+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 <ssh-connection-configuration> 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
+<ssh-connection-configuration> 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
+<ssh-connection-configuration> 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
+<ssh-connection-configuration> 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
+<ssh-connection-configuration> 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
+<ssh-connection-configuration> 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 <ssh-connection-configuration> 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
Maze <maze@HIDDEN>:guix-patches@HIDDEN.
Full text available.guix-patches@HIDDEN:bug#64349; Package guix-patches.
Full text available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997 nCipher Corporation Ltd,
1994-97 Ian Jackson.