Mirror of GNU Guix
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

82 lines
3.2 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
  3. ;;;
  4. ;;; This file is part of GNU Guix.
  5. ;;;
  6. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 3 of the License, or (at
  9. ;;; your option) any later version.
  10. ;;;
  11. ;;; GNU Guix is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  18. ;;;
  19. ;;; Validate 'etc/news.scm'.
  20. ;;;
  21. (use-modules (git)
  22. (guix git)
  23. (guix ui)
  24. (guix channels)
  25. (srfi srfi-26)
  26. (ice-9 match))
  27. ;; XXX: These two things are currently private.
  28. (define read-channel-news (@@ (guix channels) read-channel-news))
  29. (define channel-news-entries (cut struct-ref <> 0))
  30. (define (all-the-news directory)
  31. "Return the <channel-news> read from DIRECTORY, a checkout of the 'guix'
  32. channel."
  33. (call-with-input-file (string-append directory "/etc/news.scm")
  34. read-channel-news))
  35. (define (validate-texinfo str type language)
  36. "Parse STR as a Texinfo fragment and raise an error if that fails."
  37. (catch #t
  38. (lambda ()
  39. (texi->plain-text str))
  40. (lambda (key . args)
  41. (print-exception (current-error-port) #f key args)
  42. (report-error (G_ "the Texinfo snippet below is invalid (~a, ~a):~%")
  43. type language)
  44. (display str (current-error-port))
  45. (exit 1))))
  46. (define (validate-news-entry repository entry)
  47. "Validate ENTRY, a <channel-news-entry>, making sure it refers to an
  48. existent commit of REPOSITORY and contains only valid Texinfo."
  49. (catch 'git-error
  50. (lambda ()
  51. (let ((commit (commit-lookup repository
  52. (string->oid
  53. (channel-news-entry-commit entry)))))
  54. (for-each (match-lambda
  55. ((language . title)
  56. (validate-texinfo title 'title language)))
  57. (channel-news-entry-title entry))
  58. (for-each (match-lambda
  59. ((language . body)
  60. (validate-texinfo body 'body language)))
  61. (channel-news-entry-body entry))))
  62. (lambda (key error . rest)
  63. (if (= GIT_ENOTFOUND (git-error-code error))
  64. (leave (G_ "commit '~a' of entry '~a' does not exist~%")
  65. (channel-news-entry-commit entry)
  66. (channel-news-entry-title entry))
  67. (apply throw key error rest)))))
  68. (let* ((this-directory (dirname (current-filename)))
  69. (top-directory (string-append this-directory "/.."))
  70. (entries (channel-news-entries (all-the-news top-directory))))
  71. (with-repository top-directory repository
  72. (for-each (cut validate-news-entry repository <>)
  73. entries)
  74. (info (G_ "All ~a channel news entries are valid.~%")
  75. (length entries))))