diff --git a/sponsor-debian.el b/sponsor-debian.el index 8a73989..e01a8b9 100644 --- a/sponsor-debian.el +++ b/sponsor-debian.el @@ -1,4 +1,4 @@ -;;; sponsor-debian.el --- Make it easy to sponsor packages on Debian. +;;; sponsor-debian-pkg.el --- Make it easy to sponsor packages on Debian. ;;; ;;; Commentary: ;;; @@ -33,22 +33,7 @@ :group 'sdj/sponsor-debian-pkg :type 'string) -(defun sdj/sponsor--generate-sponsoree-candidates-from-dir () - "Generate a list of sponsoree candidates from the contents of 'sdj/sponsor-debian-pkg-path'. - -The idea is that each directory name inside that path corresponds -to a salsa.d.o username." - (flatten-tree - (mapcar - (lambda (e) - (let ((dirname (car e))) - (when (and (nth 2 e) - ; Exclude "." and ".." from the list - (not (seq-contains-p '("." "..") dirname))) - dirname))) - (directory-files-and-attributes sdj/sponsor-debian-pkg-path)))) - -(defun sdj/sponsor--generate-sponsoree-candidates () +(defun sdj/sponsor-debian-pkg--generate-sponsoree-candidates () "Generate a list of sponsoree candidates from salsa.d.o. The idea is to query Debian Brasilia's 'docs' project, obtain a @@ -57,11 +42,11 @@ ever commented on those issues. Return an alist of (user . username)." (let* ((debian-bsb-users (plz 'get - (concat sdj/sponsor-debian-pkg-salsa-api-url + (concat sdj/sponsor-debian-pkg-debian-pkg-salsa-api-url "projects/" (url-hexify-string "debian-brasilia-team/docs") "/issues?per_page=100&order_by=updated_at") - :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token)) + :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-debian-pkg-salsa-api-token)) :timeout 60 :connect-timeout 60 :as #'json-read))) @@ -74,7 +59,7 @@ Return an alist of (user . username)." (cons (format "%s (%s)" name username) username))) debian-bsb-users)))) -(defun sdj/sponsor--parse-teams () +(defun sdj/sponsor-debian-pkg--parse-teams () "Parse a JSON representation of all teams which we are subscribed to. Return an alist of (team . id)." @@ -87,18 +72,25 @@ Return an alist of (team . id)." (cons (alist-get 'full_path e) (alist-get 'id e)))) parsedteams)))) -(defun sdj/sponsor--api-endpoint (name) - (concat sdj/sponsor-debian-pkg-salsa-api-url name "/")) +(defun sdj/sponsor-debian-pkg--api-endpoint (name) + "Return the full URL for an API endpoint ending with 'NAME'. -(defun sdj/sponsor--generate-team-candidates () - (plz 'get (sdj/sponsor--api-endpoint "namespaces") - :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token)) - :as #'sdj/sponsor--parse-teams)) +The endpoint will always end with a slash." + (concat sdj/sponsor-debian-pkg-debian-pkg-salsa-api-url name "/")) -(defun sdj/sponsor--team-repo-exists-p (team repo) +(defun sdj/sponsor-debian-pkg--generate-team-candidates () + "Generate a list of candidates for team names. + +The generated list is actually a list of namespaces the user is a member of." + (plz 'get (sdj/sponsor-debian-pkg--api-endpoint "namespaces") + :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-debian-pkg-salsa-api-token)) + :as #'sdj/sponsor-debian-pkg--parse-teams)) + +(defun sdj/sponsor-debian-pkg--team-repo-exists-p (team repo) + "Check if 'REPO' (under 'TEAM' namespace) exists." (condition-case err (let ((r (plz 'get - (concat (sdj/sponsor--api-endpoint "projects") + (concat (sdj/sponsor-debian-pkg--api-endpoint "projects") (url-hexify-string (concat team "/" repo))) :as 'response))) (when (plz-response-p r) @@ -107,87 +99,115 @@ Return an alist of (team . id)." (404 nil)))) (plz-error nil))) -(defun sdj/sponsor--sanitize-import-url (url) +(defun sdj/sponsor-debian-pkg--sanitize-import-url (url) + "Sanitize the git import URL to be used when creating a new project. + +This will always make sure to replace 'git@salsa.debian.org:' +with 'https://salsa.debian.org/', and append a '.git' suffix if +needed." (concat (string-replace "git@salsa.debian.org:" "https://salsa.debian.org/" url) (unless (string-suffix-p ".git" url) ".git"))) -(defun sdj/sponsor--parse-new-repo-clone-url () +(defun sdj/sponsor-debian-pkg--parse-new-repo-clone-url () + "Parse the JSON returned when creating a new project, returning its clone URL." (let ((parsenewrepo (json-read))) (alist-get 'ssh_url_to_repo parsenewrepo))) -(defun sdj/sponsor--create-team-repo (team projname repourl) - (plz 'post (sdj/sponsor--api-endpoint "projects") +(defun sdj/sponsor-debian-pkg--create-team-repo (team projname &optional import-repourl) + "Create a repository named 'PROJNAME' under 'TEAM' namespace. + +If 'IMPORT-REPOURL' is provided, use it as the initial import." + (plz 'post (sdj/sponsor-debian-pkg--api-endpoint "projects") :headers `(("Content-Type" . "application/json") - ("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token)) + ("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-debian-pkg-salsa-api-token)) :body (json-encode (delete nil `(("name" . ,projname) ("description" . ,(concat "Debian package for " projname)) - ,(when repourl - `("import_url" . ,(sdj/sponsor--sanitize-import-url repourl))) + ,(when import-repourl + `("import_url" . ,(sdj/sponsor-debian-pkg--sanitize-import-url import-repourl))) ("namespace_id" . ,(cdr team)) ("initialize_with_readme" . false)))) - :as #'sdj/sponsor--parse-new-repo-clone-url)) + :as #'sdj/sponsor-debian-pkg--parse-new-repo-clone-url)) -(defun sdj/sponsor--make-team-repo-url (team projname) +(defun sdj/sponsor-debian-pkg--make-team-repo-url (team projname) + "Given 'TEAM' and 'PROJNAME', return the repository URL. + +This URL is used for cloning purposes, and therefore starts with +'git@salsa.debian.org:'." (concat "git@salsa.debian.org:" (car team) "/" projname ".git")) -(defun sdj/sponsor--get-or-create-team-repo (team projname repourl &optional dontask-p) - (if (sdj/sponsor--team-repo-exists-p (car team) projname) - (sdj/sponsor--make-team-repo-url team projname) +(defun sdj/sponsor-debian-pkg--get-or-create-team-repo (team projname &options import-repourl dontask-p) + "Get or create a new repository under 'TEAM'. + +If 'IMPORT-REPOURL' is provided, use it as the initial repository content. + +If 'DONTASK-P' is t, don't ask whether the user would like to +create the repository." + (if (sdj/sponsor-debian-pkg--team-repo-exists-p (car team) projname) + (sdj/sponsor-debian-pkg--make-team-repo-url team projname) (when (or dontask-p (y-or-n-p "Would you like to create the repository under the team's namespace? ")) (message "Creating the team repository (%s/%s.git)..." (car team) projname) - (sdj/sponsor--create-team-repo team projname repourl)))) + (sdj/sponsor-debian-pkg--create-team-repo team projname import-repourl)))) -(defun sdj/sponsor--confirm-username (user) +(defun sdj/sponsor-debian-pkg--confirm-username (user) + "Confirm if 'USER' exists." (let ((u (plz 'get - (concat sdj/sponsor-debian-pkg-salsa-api-url "users?username=" (url-hexify-string user)) - :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token)) + (concat sdj/sponsor-debian-pkg-debian-pkg-salsa-api-url "users?username=" (url-hexify-string user)) + :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-debian-pkg-salsa-api-token)) :as #'json-read))) (and (not (seq-empty-p u)) user))) -(defun sdj/sponsor--confirm-team (team) +(defun sdj/sponsor-debian-pkg--confirm-team (team) + "Confirm if 'TEAM' exists. + +Note that internally teams are actually treated as namespaces." (condition-case err (let ((u (plz 'get - (concat sdj/sponsor-debian-pkg-salsa-api-url "namespaces/" (url-hexify-string team)) - :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token)) + (concat sdj/sponsor-debian-pkg-debian-pkg-salsa-api-url "namespaces/" (url-hexify-string team)) + :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-debian-pkg-salsa-api-token)) :as #'json-read))) (and (not (seq-empty-p u)) (cons team (alist-get 'id u)))) (plz-error nil))) -(defun sdj/sponsor--read-sponsoree-choice () - (let* ((sponsoreealist (sdj/sponsor--generate-sponsoree-candidates)) +(defun sdj/sponsor-debian-pkg--read-sponsoree-choice () + "Read the sponsoree." + (let* ((sponsoreealist (sdj/sponsor-debian-pkg--generate-sponsoree-candidates)) (sponsoreechoice (completing-read "Sponsoree: " sponsoreealist))) (or (alist-get sponsoreechoice sponsoreealist nil nil #'string=) - (sdj/sponsor--confirm-username sponsoreechoice)))) + (sdj/sponsor-debian-pkg--confirm-username sponsoreechoice)))) -(defun sdj/sponsor--read-team-choice (&optional dontask-p) +(defun sdj/sponsor-debian-pkg--read-team-choice (&optional dontask-p) + "Read the team." (when (or dontask-p (y-or-n-p "Would you like to specify a team? ")) - (let* ((teamalist (sdj/sponsor--generate-team-candidates)) + (let* ((teamalist (sdj/sponsor-debian-pkg--generate-team-candidates)) (teamchoice (completing-read "Team: " teamalist nil t))) (cons teamchoice (alist-get teamchoice teamalist nil nil #'string=))))) -(defun sdj/sponsor--read-string-or-nil (prompt) +(defun sdj/sponsor-debian-pkg--read-string-or-nil (prompt) + "Read a string from the minibuffer or nil." (let ((r (read-from-minibuffer prompt))) (unless (string-empty-p r) r))) -(defun sdj/sponsor--read-repourl (&optional prompt) - (let ((r (sdj/sponsor--read-string-or-nil (or prompt +(defun sdj/sponsor-debian-pkg--read-repourl (&optional prompt) + "Read a repository URL." + (let ((r (sdj/sponsor-debian-pkg--read-string-or-nil (or prompt "Repository URL: ")))) (when r (string-remove-suffix "/" r)))) -(defun sdj/sponsor--get-namespace-from-repourl (repourl) +(defun sdj/sponsor-debian-pkg--get-namespace-from-repourl (repourl) + "Given a repository URL 'REPOURL', return its namespace." (let ((str-no-url (or (and (string-prefix-p "git@salsa.debian.org:" repourl) (string-remove-prefix "git@salsa.debian.org:" repourl)) (and (string-prefix-p "https://salsa.debian.org/" repourl) @@ -199,19 +219,18 @@ Return an alist of (team . id)." (file-name-directory (string-remove-suffix "/" str-no-url)))))) - ;; (replace-regexp-in-string - ;; (rx - ;; (or "git@salsa.debian.org:" "https://salsa.debian.org/") - ;; (group (one-or-more (not "/"))) (minimal-match (one-or-more not-newline))) - ;; "\\1" repourl nil nil nil )) - -(defun sdj/sponsor--get-project-from-repourl (repourl) +(defun sdj/sponsor-debian-pkg--get-project-from-repourl (repourl) + "Given a repository URL 'REPOURL', return its project name." (file-name-base (string-remove-suffix "/" repourl))) -(defun sdj/sponsor--what-is-this-namespace (namespace) - (let* ((username (sdj/sponsor--confirm-username namespace)) +(defun sdj/sponsor-debian-pkg--what-is-this-namespace (namespace) + "Given a namespace 'NAMESPACE', identify it. + +Return an alist of (ID . DATA), where 'ID' is either 'username or +'team, and 'DATA' is information about the namespace." + (let* ((username (sdj/sponsor-debian-pkg--confirm-username namespace)) (team (and (not username) - (sdj/sponsor--confirm-team namespace)))) + (sdj/sponsor-debian-pkg--confirm-team namespace)))) (cond (username (cons 'username username)) @@ -220,33 +239,38 @@ Return an alist of (team . id)." (t (error "Could not find namespace '%s'" namespace))))) -(defun sdj/sponsor-init--read-args () - (let* ((repo (sdj/sponsor--read-repourl)) - (namespace (sdj/sponsor--get-namespace-from-repourl repo)) - (result (sdj/sponsor--what-is-this-namespace namespace)) +(defun sdj/sponsor-debian-pkg--read-args () + "Read arguments from the minibuffer." + (let* ((repo (sdj/sponsor-debian-pkg--read-repourl)) + (namespace (sdj/sponsor-debian-pkg--get-namespace-from-repourl repo)) + (result (sdj/sponsor-debian-pkg--what-is-this-namespace namespace)) (team (or (and (eq (car result) 'team) (cdr result)) - (sdj/sponsor--read-team-choice))) + (sdj/sponsor-debian-pkg--read-team-choice))) (sponsoree (or (and (eq (car result) 'username) (cdr result)) - (sdj/sponsor--read-sponsoree-choice)))) + (sdj/sponsor-debian-pkg--read-sponsoree-choice)))) (when (y-or-n-p (format "Sponsoree: [%s]; Team: [%s]; OK? " sponsoree (or (car team) "none"))) (list sponsoree team repo)))) ;;;###autoload -(defun sdj/sponsor-create-team-repo (team projname sponsoree-repourl) +(defun sdj/sponsor-debian-pkg-create-team-repo (team projname sponsoree-repourl) + "Create a team repository. + +If 'SPONSOREE-REPOURL' is provided, use it as a base for the +initial repository." (interactive (list - (sdj/sponsor--read-team-choice t) - (sdj/sponsor--read-string-or-nil "Project name: ") - (sdj/sponsor--read-repourl "Sponsoree repository to import into the new one (optional): "))) + (sdj/sponsor-debian-pkg--read-team-choice t) + (sdj/sponsor-debian-pkg--read-string-or-nil "Project name: ") + (sdj/sponsor-debian-pkg--read-repourl "Sponsoree repository to import into the new one (optional): "))) (when (or (not team) (not projname)) (error "You must provide a valid team and a project name")) - (let ((team-repourl (sdj/sponsor--get-or-create-team-repo team projname sponsoree-repourl t))) + (let ((team-repourl (sdj/sponsor-debian-pkg--get-or-create-team-repo team projname sponsoree-repourl t))) (when sponsoree-repourl - (when-let* ((sponsoree (sdj/sponsor--get-namespace-from-repourl sponsoree-repourl)) + (when-let* ((sponsoree (sdj/sponsor-debian-pkg--get-namespace-from-repourl sponsoree-repourl)) (sponsoreedir (file-name-as-directory - (concat sdj/sponsor-debian-pkg-path sponsoree))) + (concat sdj/sponsor-debian-pkg-debian-pkg-path sponsoree))) (projdir (file-name-as-directory (concat sponsoreedir projname))) (team-gitdir (file-name-as-directory @@ -269,14 +293,14 @@ Return an alist of (team . id)." "fetch" sponsoree)))))))) ;;;###autoload -(defun sdj/sponsor-init (sponsoree team repo) +(defun sdj/sponsor-debian-pkg (sponsoree team repo) (interactive - (sdj/sponsor-init--read-args)) + (sdj/sponsor-debian-pkg--read-args)) (when (or (not sponsoree) (not repo)) (error "You must provide a valid sponsoree name and a repository URL")) - (let* ((projname (sdj/sponsor--get-project-from-repourl repo)) + (let* ((projname (sdj/sponsor-debian-pkg--get-project-from-repourl repo)) (sponsoreedir (file-name-as-directory - (concat sdj/sponsor-debian-pkg-path sponsoree))) + (concat sdj/sponsor-debian-pkg-debian-pkg-path sponsoree))) (projdir (file-name-as-directory (concat sponsoreedir projname))) (repo-is-private-p (string-search (concat "/" sponsoree "/") repo)) @@ -291,7 +315,7 @@ Return an alist of (team . id)." (call-process "gbp" nil (get-buffer-create "*gbp output*") nil "clone" repo sponsoree-gitdir)) (when (and team repo-is-private-p) - (when-let ((team-repourl (sdj/sponsor--get-or-create-team-repo team projname repo)) + (when-let ((team-repourl (sdj/sponsor-debian-pkg--get-or-create-team-repo team projname repo)) (team-gitdir (concat projdir projname))) (unless (file-directory-p team-gitdir) (message "Cloning the team repository...") @@ -307,6 +331,6 @@ Return an alist of (team . id)." "fetch" sponsoree)))))) (dired sponsoree-gitdir))) -(provide 'sponsor-debian) +(provide 'sponsor-debian-pkg) -;;; sponsor-debian.el ends here +;;; sponsor-debian-pkg.el ends here