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

34
guix/import/nuget.scm
View file

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