From mboxrd@z Thu Jan 1 00:00:00 1970 From: ludo@gnu.org (Ludovic =?utf-8?Q?Court=C3=A8s?=) Subject: Re: [UX] real names exposed Date: Sun, 04 Sep 2016 21:41:01 +0200 Message-ID: <87poojihbm.fsf@gnu.org> References: <147266794967.23966.13712862947716543821@what> <20160831231110.GB18814@jasmine> <87wpiwt2qx.fsf@gnu.org> <87bn04k40m.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:52190) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bgdI2-0003J5-IW for help-guix@gnu.org; Sun, 04 Sep 2016 15:41:15 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bgdI0-0002Jh-9e for help-guix@gnu.org; Sun, 04 Sep 2016 15:41:13 -0400 In-Reply-To: <87bn04k40m.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Sun, 04 Sep 2016 00:33:13 +0200") List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: help-guix-bounces+gcggh-help-guix=m.gmane.org@gnu.org Sender: "Help-Guix" To: Eric Bavier Cc: help-guix@gnu.org, Help-Guix --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable While playing with =E2=80=98wrap-program=E2=80=99, I rewrote it so create a= single wrapper and modify that wrapper when it exists instead of layering an extra wrapper. Thoughts? If there are no objections, I=E2=80=99d like to commit this one. Thanks, Ludo=E2=80=99. --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable modified guix/build/utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2012, 2013, 2014, 2015 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2012, 2013, 2014, 2015, 2016 Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2013 Andreas Enge ;;; Copyright =C2=A9 2013 Nikita Karetnikov ;;; Copyright =C2=A9 2015 Mark H Weaver @@ -946,62 +946,68 @@ modules in $GUILE_LOAD_PATH, etc. =20 If PROG has previously been wrapped by wrap-program the wrapper will point= to the previous wrapper." - (define (wrapper-file-name number) - (format #f "~a/.~a-wrap-~2'0d" (dirname prog) (basename prog) number)) - (define (next-wrapper-number) - (let ((wrappers - (find-files (dirname prog) - (string-append "\\." (basename prog) "-wrap-.*")))) - (if (null? wrappers) - 0 - (string->number (string-take-right (last wrappers) 2))))) - (define (wrapper-target number) - (if (zero? number) - (let ((prog-real (string-append (dirname prog) "/." - (basename prog) "-real"))) - (rename-file prog prog-real) - prog-real) - (wrapper-file-name number))) + (define wrapped-file + (string-append (dirname prog) "/." (basename prog) "-real")) =20 - (let* ((number (next-wrapper-number)) - (target (wrapper-target number)) - (wrapper (wrapper-file-name (1+ number))) - (prog-tmp (string-append target "-tmp"))) - (define (export-variable lst) - ;; Return a string that exports an environment variable. - (match lst - ((var sep '=3D rest) - (format #f "export ~a=3D\"~a\"" - var (string-join rest sep))) - ((var sep 'prefix rest) - (format #f "export ~a=3D\"~a${~a~a+~a}$~a\"" - var (string-join rest sep) var sep sep var)) - ((var sep 'suffix rest) - (format #f "export ~a=3D\"$~a${~a~a+~a}~a\"" - var var var sep sep (string-join rest sep))) - ((var '=3D rest) - (format #f "export ~a=3D\"~a\"" - var (string-join rest ":"))) - ((var 'prefix rest) - (format #f "export ~a=3D\"~a${~a:+:}$~a\"" - var (string-join rest ":") var var)) - ((var 'suffix rest) - (format #f "export ~a=3D\"$~a${~a:+:}~a\"" - var var var (string-join rest ":"))))) + (define already-wrapped? + (file-exists? wrapped-file)) =20 - (with-output-to-file prog-tmp - (lambda () - (format #t - "#!~a~%~a~%exec -a \"$0\" \"~a\" \"$@\"~%" - (which "bash") - (string-join (map export-variable vars) - "\n") - (canonicalize-path target)))) + (define (last-line port) + (let loop ((previous-line-offset 0) + (previous-line "") + (position (seek port 0 SEEK_CUR))) + (match (read-line port 'concat) + ((? eof-object?) + (seek port previous-line-offset SEEK_SET) + previous-line) + ((? string? line) + (loop position line (+ (string-length line) position)))))) =20 - (chmod prog-tmp #o755) - (rename-file prog-tmp wrapper) - (symlink wrapper prog-tmp) - (rename-file prog-tmp prog))) + (define (export-variable lst) + ;; Return a string that exports an environment variable. + (match lst + ((var sep '=3D rest) + (format #f "export ~a=3D\"~a\"" + var (string-join rest sep))) + ((var sep 'prefix rest) + (format #f "export ~a=3D\"~a${~a~a+~a}$~a\"" + var (string-join rest sep) var sep sep var)) + ((var sep 'suffix rest) + (format #f "export ~a=3D\"$~a${~a~a+~a}~a\"" + var var var sep sep (string-join rest sep))) + ((var '=3D rest) + (format #f "export ~a=3D\"~a\"" + var (string-join rest ":"))) + ((var 'prefix rest) + (format #f "export ~a=3D\"~a${~a:+:}$~a\"" + var (string-join rest ":") var var)) + ((var 'suffix rest) + (format #f "export ~a=3D\"$~a${~a:+:}~a\"" + var var var (string-join rest ":"))))) + + (if already-wrapped? + (let* ((port (open-file prog "r+")) + (last (last-line port))) + (for-each (lambda (var) + (display (export-variable var) port) + (newline port)) + vars) + (display last port) + (close-port port)) + (let ((prog-tmp (string-append wrapped-file "-tmp"))) + (copy-file prog wrapped-file) + + (call-with-output-file prog-tmp + (lambda (port) + (format port + "#!~a --~%~a~%exec -a \"$0\" \"~a\" \"$@\"~%" + (which "bash") + (string-join (map export-variable vars) + "\n") + (canonicalize-path wrapped-file)))) + + (chmod prog-tmp #o755) + (rename-file prog-tmp prog)))) =20 --=-=-=--