bug#73166: shell-autorized-directories

bug#73166: shell-autorized-directories

[Nicolas Graves]

According to current uses of the XDG base dirs specification, I think
guix shell-autorized-directories is in the wrong place, and should
instead be in $XDG_STATE_HOME/guix/

direnv uses $XDG_STATE_HOME too to store authorized directories, and it
also makes more sense in the context of immutable configs

WDYT? Should we implement this change? The tricky thing might be the
migration for those files. Maybe we should also add a --allow argument
to guix shell to make it easier to add files.

-- 
Best regards,
Nicolas Graves

bug#73166: shell-autorized-directories

[Ludovic Courtès]

Hi,

Nicolas Graves <ngraves@ngraves.fr> skribis:

> According to current uses of the XDG base dirs specification, I think
> guix shell-autorized-directories is in the wrong place, and should
> instead be in $XDG_STATE_HOME/guix/
>
> direnv uses $XDG_STATE_HOME too to store authorized directories, and it
> also makes more sense in the context of immutable configs

Is it that clear-cut?  It can be viewed as config rather than state too,
no?

> WDYT? Should we implement this change? The tricky thing might be the
> migration for those files.

Right, migration in itself is difficult.  Not to mention that we’d have
to account for people who use ‘time-machine’ to run a pre-migration
shell.

> Maybe we should also add a --allow argument to guix shell to make it
> easier to add files.

That option would add a line to ‘shell-autorized-directories’?

Thanks,
Ludo’.

bug#73166: shell-autorized-directories

[Nicolas Graves]

On 2024-09-11 11:52, Ludovic Courtès wrote:

> Hi,
>
> Nicolas Graves <ngraves@ngraves.fr> skribis:
>
> Is it that clear-cut?  It can be viewed as config rather than state too,
> no?

Possibly, though I'm not sure which use-case will make more sense using
this file as config rather than state.

In my use-case I tried to have an as-much-as-possible immutable home
config, and since I don't think it makes sense to run a guix home
reconfiguration after `echo X > ~/wherever/guix-shell-authorized-directories`,
I had to make a uggly trick/exception for this file.

>
>> WDYT? Should we implement this change? The tricky thing might be the
>> migration for those files.
>
> Right, migration in itself is difficult.  Not to mention that we’d have
> to account for people who use ‘time-machine’ to run a pre-migration
> shell.

Question is, is that worth it ? Probably not for only file relocation,
but I now think we need more, see next answer.

>
>> Maybe we should also add a --allow argument to guix shell to make it
>> easier to add files.
>
> That option would add a line to ‘shell-autorized-directories’?

Yes. Actually I would like to develop a little more after thinking about
that.

Let's say you git pull code from a guix-shell-authorized repo and the 
pull includes some potentially harmful / dangerous code.

The assumption of direnv is that the user has to allow the code to run
again in this case, putting more emphasis on security. This is not the
case in Guix, IIRC. I think it should be done in Guix too. 

Implementing that kind of additional security will indeed need such an
option, for this will need to actually include the hash of the file of
something like that.

It's actually quite simple in direnv, they take a sha256 hash of the
absolute filename + the content of the file.
(See
https://github.com/nicolas-graves/python-direnv/blob/f8f0967a9772f0775ffe75a68d868c75076f5af4/direnv.py#L36)
That hash makes a simple file-based database where a file is allowed based
not only on its location but on its location+content.

We could have two options to interact with such a database :
--allow
--revoke

>
> Thanks,
> Ludo’.

-- 
Best regards,
Nicolas Graves

bug#73166: shell-autorized-directories

[Nicolas Graves]

On 2024-09-11 16:11, Nicolas Graves wrote:

>> That option would add a line to ‘shell-autorized-directories’?
>
> Yes. Actually I would like to develop a little more after thinking about
> that.
>
> Let's say you git pull code from a guix-shell-authorized repo and the 
> pull includes some potentially harmful / dangerous code.
>
> The assumption of direnv is that the user has to allow the code to run
> again in this case, putting more emphasis on security. This is not the
> case in Guix, IIRC. I think it should be done in Guix too. 
>
> Implementing that kind of additional security will indeed need such an
> option, for this will need to actually include the hash of the file of
> something like that.
>
> It's actually quite simple in direnv, they take a sha256 hash of the
> absolute filename + the content of the file.
> (See
> https://github.com/nicolas-graves/python-direnv/blob/f8f0967a9772f0775ffe75a68d868c75076f5af4/direnv.py#L36)
> That hash makes a simple file-based database where a file is allowed based
> not only on its location but on its location+content.
>
> We could have two options to interact with such a database :
> --allow
> --revoke

Here's a working draft for some code for that.  This is currently able
to properly allow or deny my direnv-validated directories.  With a
proper direnv rename, we can almost already replace
authorized-shell-directory? function.

I feel like this is a far more secure and convenient way to manage
autorized-directories for guix shell.  WDYT ?

@Andrew you might also be interested in that given your focus on
per-directory complete dev environments.  Originally I thought of this
while thinking about how unsecure patch 3 of 
https://lists.sr.ht/~abcdw/rde-devel/patches/54944 was.

I'll probably continue to work on that to bring it to a full reviewable
patch, some input would be greatly appreciated in the meantime!


(use-modules
 (gcrypt hash)
 (guix rpm) ; for bytevector->hex-string
 (guix serialization)
 (srfi srfi-1)
 (srfi srfi-11)
 (srfi srfi-26)
 (srfi srfi-71)
 (ice-9 match)
 (ice-9 textual-ports))

(define (direnv-file-hash path)
  (let* ((abs-path (canonicalize-path path))
         (content (call-with-input-file abs-path get-string-all)))
    (call-with-input-string (string-append abs-path "\n" content)
      (cut (compose bytevector->hex-string port-sha256) <>))))

(define (xdg-data-home)
  (or (getenv "XDG_DATA_HOME")
      (string-append (getenv "HOME") "/.local/share")))

(define (permissions path)
  (define (is-valid? file-path)
    (and (file-exists? file-path)
         (string=? (string-trim-right
                    (call-with-input-file file-path get-string-all))
                   (canonicalize-path path))))

  (let* ((file-hash (direnv-file-hash path))
         (database-path (string-append (xdg-data-home) "/direnv/")))
    (cond
     ((is-valid? (string-append database-path "deny/" file-hash))
      (values 'deny file-hash))
     ((is-valid? (string-append database-path "allow/" file-hash))
      (values 'allow file-hash))
     (else
      (values 'unknown file-hash)))))

(define (is-allowed? path)
  (eq? 'allow (permissions path)))

(define (is-denied? path)
  (eq? 'deny (permissions path)))

(define (allow-or-deny! path target-type origin-type)
  (let ((type file-hash (permissions path))
        (data-home (string-append (xdg-data-home) "/direnv/")))
    (match type
      (origin-type
       (rename-file
        (string-append data-home (symbol->string origin-type) "/" file-hash)
        (string-append data-home (symbol->string target-type) "/" file-hash)))
      (target-type
       (warn "not necessary"))  ;TODO do that properly
      ('unknown
       (call-with-output-file
           (string-append data-home (symbol->string target-type) "/" file-hash)
         (cut display (canonicalize-path path) <>))))))

(define (allow! path)
  (allow-or-deny! path 'allow 'deny))

(define (deny! path)
  (allow-or-deny! path 'deny 'allow))

-- 
Best regards,
Nicolas Graves

bug#73166: shell-autorized-directories

[Saku Laesvuori via Bug reports for GNU Guix]

[-- Attachment #1: Type: text/plain, Size: 2920 bytes --]

On Sat, Nov 09, 2024 at 03:12:44PM +0100, Nicolas Graves wrote:
> On 2024-09-11 16:11, Nicolas Graves wrote:
> 
> >> That option would add a line to ‘shell-autorized-directories’?
> >
> > Yes. Actually I would like to develop a little more after thinking about
> > that.
> >
> > Let's say you git pull code from a guix-shell-authorized repo and the 
> > pull includes some potentially harmful / dangerous code.
> >
> > The assumption of direnv is that the user has to allow the code to run
> > again in this case, putting more emphasis on security. This is not the
> > case in Guix, IIRC. I think it should be done in Guix too. 
> >
> > Implementing that kind of additional security will indeed need such an
> > option, for this will need to actually include the hash of the file of
> > something like that.
> >
> > It's actually quite simple in direnv, they take a sha256 hash of the
> > absolute filename + the content of the file.
> > (See
> > https://github.com/nicolas-graves/python-direnv/blob/f8f0967a9772f0775ffe75a68d868c75076f5af4/direnv.py#L36)
> > That hash makes a simple file-based database where a file is allowed based
> > not only on its location but on its location+content.
> >
> > We could have two options to interact with such a database :
> > --allow
> > --revoke
> 
> Here's a working draft for some code for that.  This is currently able
> to properly allow or deny my direnv-validated directories.  With a
> proper direnv rename, we can almost already replace
> authorized-shell-directory? function.
> 
> I feel like this is a far more secure and convenient way to manage
> autorized-directories for guix shell.  WDYT ?

I do agree that it seems more convenient to run `guix shell --allow`
than copy a rather long line from the hint and run it to append a line
to shell-authorized-directories.

Authorizing files instead of directories does not seem that great of an
idea to me. I doubt it really improves security that much. For example,
all my projects have a .guix/modules/xxx-package.scm file that contains
the package definition and guix.scm just loads it from that file.
Malicious code could be added here without touching the guix.scm file at
all, so the file-based authorization would not notice it.

So this would only increase security when guix.scm does not refer to any
other files in the untrusted directory. Here it might get quite annoying
to re-authorize the directory every time every time someone changes the
version number.

Thus it seems that file-based authorization will only catch
false-positives. At least I would refactor my repository to a guix
channel and load the packaged from there with guix.scm to bypass this
security mechanism before adding any malicious code.

Hashing the entire untrusted directory could work, but I'm not sure
would that have acceptable performance in larger cases.

- Saku

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

bug#73166: shell-autorized-directories

[Nicolas Graves]

On 2024-11-10 11:58, Saku Laesvuori wrote:

>
> I do agree that it seems more convenient to run `guix shell --allow`
> than copy a rather long line from the hint and run it to append a line
> to shell-authorized-directories.
>
> Authorizing files instead of directories does not seem that great of an
> idea to me. I doubt it really improves security that much. For example,
> all my projects have a .guix/modules/xxx-package.scm file that contains
> the package definition and guix.scm just loads it from that file.
> Malicious code could be added here without touching the guix.scm file at
> all, so the file-based authorization would not notice it.
>
> So this would only increase security when guix.scm does not refer to any
> other files in the untrusted directory. Here it might get quite annoying
> to re-authorize the directory every time every time someone changes the
> version number.

Thanks for your feedback Saku.

Indeed, it only increases security for revisions of guix.scm and
manifest.scm, not the repository as a whole.  But I think it's the exact
same problematic for tools like direnv (same approach as here) or even
emacs .dir-locals.el (which checks the last modified time of this file
IIRC).  They can't vouch for the whole repository, but they can
guarantee that the user explicitely accepted to run a guix.scm or
manifest.scm (respectively a .envrc or .dir-locals.el) that depends on
other files in the repo (that was not a guarantee previously, you could
accept to run a manifest.scm before it depends on files in the repo).

I guess there are two use-cases :
1) scheme development with guix.scm loading local changes: Indeed this
change is not really improving security, but neither is it harmful.
2) custom manifest.scm in non-scheme projects (my use-case): Often in
this case you would only change your manifest.scm, and it indeed
increases security (the alternative would have been to automatically add
the -m manifest.scm option but I'm not feeling secure with this
alternative).
More on my use-case: https://lists.sr.ht/~abcdw/rde-devel/patches/54944

> Thus it seems that file-based authorization will only catch
> false-positives. At least I would refactor my repository to a guix
> channel and load the packaged from there with guix.scm to bypass this
> security mechanism before adding any malicious code.
>
> Hashing the entire untrusted directory could work, but I'm not sure
> would that have acceptable performance in larger cases.

Another option could be to add the expected output path of the guix
shell invocation in the hash?  This could be simpler than hashing the
whole directory.

Although I'm not sure this is convenient for neither use-cases.
Validation with guix shell --allow for every code change is not
convenient.

-- 
Best regards,
Nicolas Graves

bug#73166: shell-autorized-directories

[Saku Laesvuori via Bug reports for GNU Guix]

[-- Attachment #1: Type: text/plain, Size: 4355 bytes --]

> > I do agree that it seems more convenient to run `guix shell --allow`
> > than copy a rather long line from the hint and run it to append a line
> > to shell-authorized-directories.
> >
> > Authorizing files instead of directories does not seem that great of an
> > idea to me. I doubt it really improves security that much. For example,
> > all my projects have a .guix/modules/xxx-package.scm file that contains
> > the package definition and guix.scm just loads it from that file.
> > Malicious code could be added here without touching the guix.scm file at
> > all, so the file-based authorization would not notice it.
> >
> > So this would only increase security when guix.scm does not refer to any
> > other files in the untrusted directory. Here it might get quite annoying
> > to re-authorize the directory every time every time someone changes the
> > version number.
> 
> Thanks for your feedback Saku.
> 
> Indeed, it only increases security for revisions of guix.scm and
> manifest.scm, not the repository as a whole.  But I think it's the exact
> same problematic for tools like direnv (same approach as here) or even
> emacs .dir-locals.el (which checks the last modified time of this file
> IIRC).  They can't vouch for the whole repository, but they can
> guarantee that the user explicitely accepted to run a guix.scm or
> manifest.scm (respectively a .envrc or .dir-locals.el) that depends on
> other files in the repo (that was not a guarantee previously, you could
> accept to run a manifest.scm before it depends on files in the repo).

Is it common to source other files from direnv or do people normally
just set environment variables and run programs from system PATH? If
sourcing other files is very rare with direnv and very common with guix
shell, comparing the security models is not as useful. I have never used
direnv, so I don't know. Maybe it is also often used to source
semitrusted files.

> I guess there are two use-cases :
> 1) scheme development with guix.scm loading local changes: Indeed this
> change is not really improving security, but neither is it harmful.

This case is a bit broader than just scheme but yes, the change does not
really have an impact here. The projects I refered to are mostly written
in Haskell. I load the package definitions from other files to
guix.scm/manifest.scm just to make the repositories work cleanly as Guix
channels.

> 2) custom manifest.scm in non-scheme projects (my use-case): Often in
> this case you would only change your manifest.scm, and it indeed
> increases security (the alternative would have been to automatically add
> the -m manifest.scm option but I'm not feeling secure with this
> alternative).
> More on my use-case: https://lists.sr.ht/~abcdw/rde-devel/patches/54944

Yes, but only slightly, I think. Because loading code from other files
is normal with guix manifests (see above), an attacker would first
refactor the repository into a guix channel to introduce loading from
another file in a non-suspicious way and only after that include the
malicious code.

> > Thus it seems that file-based authorization will only catch
> > false-positives. At least I would refactor my repository to a guix
> > channel and load the packaged from there with guix.scm to bypass this
> > security mechanism before adding any malicious code.
> >
> > Hashing the entire untrusted directory could work, but I'm not sure
> > would that have acceptable performance in larger cases.
> 
> Another option could be to add the expected output path of the guix
> shell invocation in the hash?  This could be simpler than hashing the
> whole directory.

That would only secure the shell environment, but the manifest could
still contain something like 

```scheme
(system* "rm -rf $HOME")
(specifications->manifest (list "hello"))
```

where the environment is safe but loading it causes bad side
effects.

> Although I'm not sure this is convenient for neither use-cases.
> Validation with guix shell --allow for every code change is not
> convenient.

That too.

Anyway, I am not opposed to this change. The only effects for my use
cases are positive (nicer UI with the --allow flag). I just want to
point out that I don't think this makes any attacks significantly
harder.

- Saku

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

bug#73166: shell-autorized-directories

[Nicolas Graves]

On 2024-11-11 09:54, Saku Laesvuori wrote:

> Is it common to source other files from direnv or do people normally
> just set environment variables and run programs from system PATH? If
> sourcing other files is very rare with direnv and very common with guix
> shell, comparing the security models is not as useful. I have never used
> direnv, so I don't know. Maybe it is also often used to source
> semitrusted files.

In the Nix/Guix space, I guess it's pretty common.  At least I do use it
this way (if I need environment variables for emacs or git to behave as
intended in a project for instance).  Outside these projects it makes
less sense, but I think it's where it's most used.

One example from my resources directory which requires some env
variables for a git hook to run properly :

export PYTHON="$(cd /tmp && guix shell python-wrapper python-tree-sitter python-pygit2 tree-sitter-bibtex -- which python)"
export PYTHONPATH="$(echo $PYTHON | cut -d/ -f-4)/lib/python$( $PYTHON -V | cut -d' ' -f2 | cut -d. -f-2 )/site-packages"
export TREE_SITTER_BIBTEX_PATH="$(echo $PYTHON | cut -d/ -f-4)/lib/tree-sitter/libtree-sitter-bibtex.so"

>> I guess there are two use-cases :
>> 1) scheme development with guix.scm loading local changes: Indeed this
>> change is not really improving security, but neither is it harmful.
>
> This case is a bit broader than just scheme but yes, the change does not
> really have an impact here. The projects I refered to are mostly written
> in Haskell. I load the package definitions from other files to
> guix.scm/manifest.scm just to make the repositories work cleanly as Guix
> channels.
>
>> 2) custom manifest.scm in non-scheme projects (my use-case): Often in
>> this case you would only change your manifest.scm, and it indeed
>> increases security (the alternative would have been to automatically add
>> the -m manifest.scm option but I'm not feeling secure with this
>> alternative).
>> More on my use-case: https://lists.sr.ht/~abcdw/rde-devel/patches/54944
>
> Yes, but only slightly, I think. Because loading code from other files
> is normal with guix manifests (see above), an attacker would first
> refactor the repository into a guix channel to introduce loading from
> another file in a non-suspicious way and only after that include the
> malicious code.

Agreed.  Though the user has to accept the introduction of loading from
another file though, this is what is better in this system IMO.  In my
use-case, transforming into a guix channel wouldn't make sense.

> Anyway, I am not opposed to this change. The only effects for my use
> cases are positive (nicer UI with the --allow flag). I just want to
> point out that I don't think this makes any attacks significantly
> harder.

Agreed on the significantly.  Let's just not give a false security
guarantee in the commit/news/manual, the user still has to be careful.

-- 
Best regards,
Nicolas Graves

bug#73166: shell-autorized-directories

[Suhail Singh]

Saku Laesvuori via Bug reports for GNU Guix <bug-guix@gnu.org> writes:

> Anyway, I am not opposed to this change. The only effects for my use
> cases are positive (nicer UI with the --allow flag). I just want to
> point out that I don't think this makes any attacks significantly
> harder.

FWIW, this summarizes my belief as well.  I do see some improvements in
convenience, but the threat model where this improves security (threat
actor has access to the repository, but the files are such that the
threat actor isn't able to modify their semantics without first
modifying the files) seems contrived.  Am I mistaken?

If not, while I don't have objections to the change (and do believe it
has some value), I do have reservations about claiming security
benefits.

-- 
Suhail

bug#73166: shell-autorized-directories

[Nicolas Graves]

On 2024-11-11 20:46, Suhail Singh wrote:

> Saku Laesvuori via Bug reports for GNU Guix <bug-guix@gnu.org> writes:
>
>> Anyway, I am not opposed to this change. The only effects for my use
>> cases are positive (nicer UI with the --allow flag). I just want to
>> point out that I don't think this makes any attacks significantly
>> harder.
>
> FWIW, this summarizes my belief as well.  I do see some improvements in
> convenience, but the threat model where this improves security (threat
> actor has access to the repository, but the files are such that the
> threat actor isn't able to modify their semantics without first
> modifying the files) seems contrived.  Am I mistaken?
>
> If not, while I don't have objections to the change (and do believe it
> has some value), I do have reservations about claiming security
> benefits.

My last message to Saku basically agreed to this ;)

I still think it improves it for my specific use-case and for the
addition of explicit user agreement to load code exterior to
manifest/guix.scm in the case this file is trusted but compromised.

But I agree the first message was probably too focussed on marginal
security improvements and we shouldn't sell a false promise that could
make people less careful.

I'm actually willing to improve that patch series if you have better
ideas/implementations, I was just building on what I know
(direnv/.dir-locals.el). Maybe we should only allow to automatically run
when the manifest is able to build without network access in container
mode. Or include things like automatic git commit authentication on such
allowed repositories.  But I'm not sure if they are convenient or easy
to implement, or make sense.

-- 
Best regards,
Nicolas Graves

bug#73166: shell-autorized-directories

[Suhail Singh]

Nicolas Graves <ngraves@ngraves.fr> writes:

> My last message to Saku basically agreed to this ;)

Yes, my bad for only noticing that message after having sent mine.
Whoops.

> I'm actually willing to improve that patch series if you have better
> ideas/implementations, I was just building on what I know
> (direnv/.dir-locals.el).

As a direnv and .dir-locals.el user myself, I think there's some utility
in doing things similarly, at least till we come up with a threat model
on which we have some consensus and which motivates us to deviate from
the norm.

> Maybe we should only allow to automatically run when the manifest is
> able to build without network access in container mode.

I was under the impression that the build phase in guix is always
containerized and without network access.  Could you please elaborate on
this?

> Or include things like automatic git commit authentication on such
> allowed repositories.  But I'm not sure if they are convenient or easy
> to implement, or make sense.

While valuable, I believe if we do provide this, it should only be done
in a manner that the user is able to disable if/as needed.

-- 
Suhail

bug#73166: shell-autorized-directories

[Nicolas Graves]

On 2024-11-12 09:50, Suhail Singh wrote:

> I was under the impression that the build phase in guix is always
> containerized and without network access.  Could you please elaborate on
> this?

Building a package yes, but you can have external commands in a
manifest.scm or guix.scm.  Saku provided an example in an earlier email
of a valid but dangerous manifest:

```scheme
(system* "rm -rf $HOME")
(specifications->manifest (list "hello"))
```

We could also have one that downloads malicious code, or uploads private
info, the POC is left as an an exercice for the reader ;) 

What I was saying is that we could restrain recording `guix shell --allow`
only if the manifest builds properly containerized and without network
access (outside package building I mean), and otherwise refuse to allow
(failing manifest, possibly because it tries to access the network or
files outside the repo) with a warning message, providing the ability to
restrain "automatic loading" to certain "safer" conditions only.

This would in turn mean that (given the same guix revision) we can
always run a `guix shell --allow`-ed using `guix shell --container`
which actually makes a lot of sense in my use-case.  I don't really know
about other use-cases, but I guess it's the same, even a scheme
developper would probably want a manifest that doesn't depend on files
outside of his repo or the network.  Saku, do you have an opinion on
this?

The downside is that we would have to basically run `guix shell
--container` (and build all there is to build) before being able to run
`guix shell --allow`.

WDYT?

-- 
Best regards,
Nicolas Graves

bug#73166: shell-autorized-directories

[Suhail Singh]

Nicolas Graves <ngraves@ngraves.fr> writes:

> Building a package yes, but you can have external commands in a
> manifest.scm or guix.scm.
>
> ...
>
> What I was saying is that we could restrain recording `guix shell --allow`
> only if the manifest builds properly containerized and without network
> access (outside package building I mean), and otherwise refuse to allow
> (failing manifest, possibly because it tries to access the network or
> files outside the repo) with a warning message, providing the ability to
> restrain "automatic loading" to certain "safer" conditions only.

I see.  I think in the event that the manifest doesn't build in a
containerized environment without networking access, providing a warning
when using --allow would be quite helpful.  It would inform the user of
situations where what's happening in the manifest has fewer guarantees.

If we were to do the above for --allow, but still allow the user to
bypass that via shell-authorized-directories if desired, I believe it
would be a good tradeoff: make well-behaved code easier to use, while
still allowing for less-well-behaved workflows with some minor
inconvenience.

I am assuming in the above that this wouldn't interfere with additional
channels being used in the repo.

> The downside is that we would have to basically run `guix shell
> --container` (and build all there is to build) before being able to
> run `guix shell --allow`.

As long as we properly document this, I think that that's acceptable.

-- 
Suhail

bug#73166: [PATCH] shell: Rewrite authorized directories management.

[Nicolas Graves]

Let's say you pull code with a malicious change in guix.scm or
manifest.scm from a repo authorized by guix shell.  guix shell would
continue to trust it.  This commit rewrites the way guix shell allow
model works, by taking inspiration (literaly doing the exact same
thing) on direnv security model.

It adds the options
  guix shell --allow
  guix shell --deny

Previous allowed directories will be lost, but will continue to work
with guix time-machine.

* guix/utils.scm (data-directory): Add variable.
* guix/scripts/shell.scm
(show-help, %options, auto-detect-manifest): Add options --allow and
--deny.
(shell-file-hash, shell-permission, database-do!): Add variables.
(authorized-directory-file): Remove variable.
(authorized-shell-directory): Rewrite and rename procedure...
(authorized-shell-file): ...to this variable.
(guix-shell): Properly dispatch allow and deny options.
* tests/guix-shell.scm : Adapt tests.
---
 guix/scripts/shell.scm | 140 +++++++++++++++++++++++++++++------------
 guix/utils.scm         |   4 ++
 tests/guix-shell.sh    |   5 +-
 3 files changed, 106 insertions(+), 43 deletions(-)

diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index d23362a15d..85794745d4 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +40,7 @@ (define-module (guix scripts shell)
   #:autoload   (ice-9 rdelim) (read-line)
   #:autoload   (guix base32) (bytevector->base32-string)
   #:autoload   (rnrs bytevectors) (string->utf8)
-  #:autoload   (guix utils) (config-directory cache-directory)
+  #:autoload   (guix utils) (cache-directory data-directory)
   #:autoload   (guix describe) (current-channels)
   #:autoload   (guix channels) (channel-commit)
   #:autoload   (gcrypt hash) (sha256)
@@ -47,6 +48,9 @@ (define-module (guix scripts shell)
   #:use-module (guix cache)
   #:use-module ((ice-9 ftw) #:select (scandir))
   #:autoload   (ice-9 pretty-print) (pretty-print)
+  #:autoload   (ice-9 textual-ports) (get-string-all)
+  #:autoload   (gcrypt hash) (port-sha256)
+  #:autoload   (guix rpm) (bytevector->hex-string)
   #:autoload   (gnu packages) (cache-is-authoritative?
                                package-unique-version-prefix
                                specification->package
@@ -75,6 +79,10 @@ (define (show-help)
   (display (G_ "
   -F, --emulate-fhs      for containers, emulate the Filesystem Hierarchy
                          Standard (FHS)"))
+  (display (G_ "
+      --allow            allow automatic loading of 'guix.scm' and 'manifest.scm'"))
+  (display (G_ "
+      --deny             revoke automatic loading of 'guix.scm' and 'manifest.scm'"))
 
   (show-environment-options-help)
   (newline)
@@ -149,7 +157,13 @@ (define %options
 
               (option '(#\F "emulate-fhs") #f #f
                       (lambda (opt name arg result)
-                        (alist-cons 'emulate-fhs? #t result))))
+                        (alist-cons 'emulate-fhs? #t result)))
+              (option '("allow") #f #f
+                      (lambda (opt name arg result)
+                        (alist-cons 'allow "allow" result)))
+              (option '("deny") #f #f
+                      (lambda (opt name arg result)
+                        (alist-cons 'deny "deny" result))))
         (filter-map (lambda (opt)
                       (and (not (any (lambda (name)
                                        (member name to-remove))
@@ -189,6 +203,68 @@ (define (handle-argument arg result)
           (("--") opts)
           (("--" command ...) (alist-cons 'exec command opts))))))))
 
+(define (shell-file-hash file)
+  "Returns a unique hash for FILE."
+  (let* ((abs-path (canonicalize-path file))
+         (content (call-with-input-file abs-path get-string-all)))
+    (call-with-input-string (string-append abs-path "\n" content)
+      (compose bytevector->hex-string port-sha256))))
+
+(define (shell-permission path)
+  "Returns the current permission of file at PATH ('allow, 'deny or 'unknown)
+and its file-hash."
+  (define (is-valid? file-path)
+    (and (file-exists? file-path)
+         (string=? (string-trim-right
+                    (call-with-input-file file-path get-string-all))
+                   (canonicalize-path path))))
+  (catch 'system-error
+    (lambda ()
+      (let* ((file-hash (shell-file-hash path))
+             (database (string-append (data-directory) "/shell/")))
+        (cond
+         ((is-valid? (string-append database "deny/" file-hash))
+          (values 'deny file-hash))
+         ((is-valid? (string-append database "allow/" file-hash))
+          (values 'allow file-hash))
+         (else
+          (values 'unknown file-hash)))))
+    (const (values #f #f))))
+
+(define (database-do! target-type path)
+  "Allows or revokes (depending on TARGET-TYPE value) guix shell automatic
+loading for the file at PATH."
+  (let ((type file-hash (shell-permission path))
+        (origin-type (match target-type
+                       ('allow 'deny)
+                       ('deny  'allow)))
+        (database (string-append (data-directory) "/shell/")))
+    (unless (file-exists? (string-append database "/allow/"))
+      (mkdir-p (string-append database "/allow/"))
+      (mkdir-p (string-append database "/deny/")))
+    (match type
+      ((? (cut eq? origin-type <>))
+       (let ((old-file (string-append
+                        database (symbol->string origin-type) "/" file-hash)))
+         (copy-file
+          old-file
+          (string-append database (symbol->string target-type) "/" file-hash))
+         (delete-file old-file)
+         (match target-type
+           ('allow (info (G_ "'~a' allowed!~%") path))
+           ('deny (info (G_ "'~a' denied!~%") path)))))
+      ((? (cut eq? target-type <>))
+       (match target-type
+         ('allow (info (G_ "'~a' is already allowed!~%") path))
+         ('deny (info (G_ "'~a' is already denied!~%") path))))
+      ('unknown
+       (call-with-output-file
+           (string-append database (symbol->string target-type) "/" file-hash)
+         (cut display (canonicalize-path path) <>))
+       (match target-type
+         ('allow (info (G_ "'~a' allowed!~%") path))
+         ('deny (info (G_ "'~a' denied!~%") path)))))))
+
 (define (find-file-in-parent-directories candidates)
   "Find one of CANDIDATES in the current directory or one of its ancestors."
   (define start (getcwd))
@@ -205,39 +281,9 @@ (define device (stat:dev (stat start)))
                (and (not (string=? directory "/"))
                     (loop (dirname directory)))))))) ;lexical ".." resolution
 
-(define (authorized-directory-file)
-  "Return the name of the file listing directories for which 'guix shell' may
-automatically load 'guix.scm' or 'manifest.scm' files."
-  (string-append (config-directory) "/shell-authorized-directories"))
-
-(define (authorized-shell-directory? directory)
-  "Return true if DIRECTORY is among the authorized directories for automatic
-loading.  The list of authorized directories is read from
-'authorized-directory-file'; each line must be either: an absolute file name,
-a hash-prefixed comment, or a blank line."
-  (catch 'system-error
-    (lambda ()
-      (call-with-input-file (authorized-directory-file)
-        (lambda (port)
-          (let loop ()
-            (match (read-line port)
-              ((? eof-object?) #f)
-              ((= string-trim line)
-               (cond ((string-prefix? "#" line)   ;comment
-                      (loop))
-                     ((string-prefix? "/" line)   ;absolute file name
-                      (or (string=? line directory)
-                          (loop)))
-                     ((string-null? (string-trim-right line)) ;blank line
-                      (loop))
-                     (else                        ;bogus line
-                      (let ((loc (location (port-filename port)
-                                           (port-line port)
-                                           (port-column port))))
-                        (warning loc (G_ "ignoring invalid file name: '~a'~%")
-                                 line)
-                        (loop))))))))))
-    (const #f)))
+(define (authorized-shell-file? file)
+  "Return true if FILE is among the authorized files for automatic loading."
+  (and=> (shell-permission file) (cut eq? 'allow <>)))
 
 (define (options-with-caching opts)
   "If OPTS contains only options that allow us to compute a cache key,
@@ -292,6 +338,8 @@ (define disallow-implicit-load?
 
   (if (or (not interactive?)
           disallow-implicit-load?
+          (assoc-ref opts 'allow)
+          (assoc-ref opts 'deny)
           (options-contain-payload? opts))
       opts
       (match (find-file-in-parent-directories '("manifest.scm" "guix.scm"))
@@ -299,7 +347,7 @@ (define disallow-implicit-load?
          (warning (G_ "no packages specified; creating an empty environment~%"))
          opts)
         (file
-         (if (authorized-shell-directory? (dirname file))
+         (if (authorized-shell-file? file)
              (begin
                (info (G_ "loading environment from '~a'...~%") file)
                (match (basename file)
@@ -314,11 +362,9 @@ (define disallow-implicit-load?
 directory, like so:
 
 @example
-echo ~a >> ~a
+guix shell --allow
 @end example\n")
-                             file
-                             (dirname file)
-                             (authorized-directory-file))
+                             file)
                (exit 1)))))))
 
 \f
@@ -596,4 +642,16 @@ (define interactive?
 
     (if (assoc-ref opts 'export-manifest?)
         (export-manifest opts (current-output-port))
-        (guix-environment* opts))))
+        (match (or (assoc-ref opts 'allow) (assoc-ref opts 'deny))
+          (#f
+           (guix-environment* opts))
+          (command
+           (match (or (assoc-ref opts 'manifest)
+                      (find-file-in-parent-directories
+                       '("manifest.scm" "guix.scm")))
+             (#f
+              (report-error
+               (G_ "no 'manifest.scm' or 'guix.scm' file to ~a~%") command)
+              (exit 1))
+             (file
+              (database-do! (string->symbol command) file))))))))
diff --git a/guix/utils.scm b/guix/utils.scm
index f161cb4ef3..51af0435e5 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -141,6 +141,7 @@ (define-module (guix utils)
 
             config-directory
             cache-directory
+            data-directory
 
             readlink*
             go-to-location
@@ -1049,6 +1050,9 @@ (define config-directory
 (define cache-directory
   (cut xdg-directory "XDG_CACHE_HOME" "/.cache" <...>))
 
+(define data-directory
+  (cut xdg-directory "XDG_DATA_HOME" "/.local/share" <...>))
+
 (define (readlink* file)
   "Call 'readlink' until the result is not a symlink."
   (define %max-symlink-depth 50)
diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh
index b2f820bf26..0606febd91 100644
--- a/tests/guix-shell.sh
+++ b/tests/guix-shell.sh
@@ -60,7 +60,7 @@ grep "not authorized" "$tmpdir/stderr"
 rm "$tmpdir/stderr"
 
 # Authorize the directory.
-echo "$(realpath "$tmpdir")" > "$configdir/guix/shell-authorized-directories"
+(cd "$tmpdir"; guix shell --allow)
 
 # Ignoring 'manifest.scm' and 'guix.scm' in non-interactive use.
 (cd "$tmpdir"; guix shell --bootstrap -- true)
@@ -78,6 +78,7 @@ cat > "$tmpdir/fake-shell.sh" <<EOF
 exec echo "\$GUIX_ENVIRONMENT"
 EOF
 chmod +x "$tmpdir/fake-shell.sh"
+(cd "$tmpdir"; SHELL="$(realpath fake-shell.sh)" guix shell --allow)
 profile1="$(cd "$tmpdir"; SHELL="$(realpath fake-shell.sh)" guix shell --bootstrap)"
 profile2="$(guix shell --bootstrap guile-bootstrap -- "$SHELL" -c 'echo $GUIX_ENVIRONMENT')"
 test -n "$profile1"
@@ -157,7 +158,7 @@ then
 
     # Honoring the local 'guix.scm' file.
     echo '(@ (guix tests) gnu-make-for-tests)' > "$tmpdir/guix.scm"
-    (cd "$tmpdir"; guix shell --bootstrap --search-paths --pure > "b")
+    (cd "$tmpdir"; guix shell --allow; guix shell --bootstrap --search-paths --pure > "b")
     cmp "$tmpdir/a" "$tmpdir/b"
     rm "$tmpdir/guix.scm"
 fi
-- 
2.46.0