amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: nuget: Use http-fetch.

Browse source 
* guix/import/nuget.scm (fetch-repo-info-from-snupkg): Use http-fetch, and
guard. Dont use mkstemp, just put-bytevector to file.

Change-Id: Ied9d64651d0ccd7875a9d80ac085cf5947c40c4c
Reviewed-by: Danny Milosavljevic <dannym@friendly-machines.com>
Signed-off-by: Sharlatan Hellseher <sharlatanus@gmail.com>
This commit is contained in:
Zheng Junjie 2025-06-20 12:05:07 +08:00 • committed by Sharlatan Hellseher
parent a8c11ecf1e
commit 92ea9e69ac
No known key found for this signature in database
GPG key ID: 76D727BFF62CD2B5
1 changed files with 17 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

30
guix/import/nuget.scm
View file

@ -29,6 +29,7 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 pretty-print) #:use-module (ice-9 pretty-print)
#:use-module (ice-9 binary-ports)
#:use-module ((rnrs) #:select (put-bytevector)) #:use-module ((rnrs) #:select (put-bytevector))
#:use-module ((sxml xpath) #:select (sxpath)) ; filter... grr #:use-module ((sxml xpath) #:select (sxpath)) ; filter... grr
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -40,6 +41,7 @@
#:use-module (sxml simple) #:use-module (sxml simple)
#:use-module (sxml match) #:use-module (sxml match)
#:use-module (web client) #:use-module (web client)
#:use-module (web uri)
#:use-module (json) #:use-module (json)
#:use-module (semver) #:use-module (semver)
#:use-module (semver ranges) #:use-module (semver ranges)
@ -250,28 +252,26 @@ primitives suitable for the 'semver-range' constructor."
file using the system 'unzip' command, and parse it to find the repository URL file using the system 'unzip' command, and parse it to find the repository URL
and commit. Returns an association list with 'url' and 'commit' keys on and commit. Returns an association list with 'url' and 'commit' keys on
success, or #f on failure." success, or #f on failure."
(let* ((name-lower (string-downcase package-name)) (let* ((name (string-append (string-downcase package-name) "." version ".snupkg"))
(snupkg-url (string-append %nuget-symbol-packages-url (snupkg-url (string-append %nuget-symbol-packages-url name)))
name-lower "." version ".snupkg")))
(format (current-error-port) (format (current-error-port)
"~%;; Source repository not found in NuGet catalog entry.~%;; ~ "~%;; Source repository not found in NuGet catalog entry.~%;; ~
Attempting to find it in symbol package: ~a~%" Attempting to find it in symbol package: ~a~%"
snupkg-url) snupkg-url)
(catch #t (catch #t
(lambda () (lambda ()
(let-values (((response body) (guard (c ((http-get-error? c)
(http-get snupkg-url))) (warning (G_ "Failed to download: ~a~%")
(if (not body) (uri->string (http-get-error-uri c)))
(begin #f))
(warning (G_ "Failed to download: ~a~%") snupkg-url) (let* ((port (http-fetch snupkg-url))
#f) (body (get-bytevector-all port)))
(call-with-temporary-directory (call-with-temporary-directory
(lambda (dir) (lambda (dir)
(let* ((archive-port (mkstemp "/tmp/myfile-XXXXXX")) (with-directory-excursion dir
(archive-file (port-filename archive-port))) (call-with-output-file name
(put-bytevector archive-port body) (cut put-bytevector <> body))
(force-output archive-port) (invoke "unzip" "-q" name "-d" dir)
(invoke "unzip" "-q" archive-file "-d" dir))
(let ((nuspec-files (find-files dir "\\.nuspec$"))) (let ((nuspec-files (find-files dir "\\.nuspec$")))
(chmod (car nuspec-files) #o400) ; some have 000 (example: flurl) (chmod (car nuspec-files) #o400) ; some have 000 (example: flurl)
(if (null? nuspec-files) (if (null? nuspec-files)
@ -302,7 +302,7 @@ success, or #f on failure."
#f))) #f)))
(,otherwise #f))) (,otherwise #f)))
((sxpath '(// metadata repository)) ((sxpath '(// metadata repository))
sxml))))))))))))) sxml))))))))))))))
(lambda (key . args) (lambda (key . args)
(warning (G_ "Failed to fetch or process snupkg file: ~a (Reason: ~a ~s)~%") (warning (G_ "Failed to fetch or process snupkg file: ~a (Reason: ~a ~s)~%")
snupkg-url key args) snupkg-url key args)