Add git owner verification option

Julien LepillerWed Oct 08 18:20:38+0200 2025

1feb300

Add git owner verification option

gitile/config.scm

2525 
            config-host
2626 
            config-database
2727 
            config-repositories
28+
            config-git-owner-validation?
2829 
            config-base-git-url
2930 
            config-index-title
3031 
            config-intro
3132 
            config-footer))
3233 
3334 
(define-record-type <config>
34-
  (make-config port host database repositories base-git-url index-title intro footer)
35+
  (make-config port host database repositories git-owner-validation?
36+
               base-git-url index-title intro footer)
3537 
  config?
36-
  (port         config-port)
37-
  (host         config-host)
38-
  (database     config-database)
39-
  (repositories config-repositories)
40-
  (base-git-url config-base-git-url)
41-
  (index-title  config-index-title)
42-
  (intro        config-intro)
43-
  (footer       config-footer))
38+
  (port                  config-port)
39+
  (host                  config-host)
40+
  (database              config-database)
41+
  (repositories          config-repositories)
42+
  (git-owner-validation? config-git-owner-validation?)
43+
  (base-git-url          config-base-git-url)
44+
  (index-title           config-index-title)
45+
  (intro                 config-intro)
46+
  (footer                config-footer))
gitile/handler.scm
1919 
(define-module (gitile handler)
2020 
  #:use-module (fibers web server)
2121 
  #:use-module (git)
22+
  #:use-module (git settings)
2223 
  #:use-module (gitile config)
2324 
  #:use-module (gitile pages)
2425 
  #:use-module (gitile repo)
…
209210 
               (loop projects))))))))
210211 
211212 
  (match config
212-
    (($ <config> port host database repositories base-git-url index-title intro
213-
        footer)
213+
    (($ <config> port host database repositories owner-validation? base-git-url
214+
        index-title intro footer)
215+
     (set-owner-validation! owner-validation?)
214216 
     (lambda (request body)
215217 
       (pk 'request request)
216218 
       (pk 'body (if body (utf8->string body) body))
scripts/gitile.in
2727 
(define* (main #:optional (args (command-line)))
2828 
  (let ((config
2929 
         (match args
30-
           ((_) (make-config 8080 "localhost" "/var/lib/gitile/gitile-db.sql"
30+
           ((_) (make-config 8080 "localhost" "/var/lib/gitile/gitile-db.sql" #t
3131 
                             "/var/lib/gitolite/repositories" "//" "Index" '() '()))
3232 
           ((_ "-c" file)
3333 
            (let ((content (call-with-input-file file read)))
3434 
              (match content
3535 
                (('config ('port port) ('host host) ('database database)
36-
                          ('repositories repositories) ('base-git-url git-base-url)
37-
                          ('index-title index-title) ('intro intro) ('footer footer))
38-
                 (make-config port host database repositories git-base-url index-title
39-
                              intro footer)))))
36+
                          ('repositories repositories) ('git-owner-validation? validation?)
37+
                          ('base-git-url git-base-url) ('index-title index-title)
38+
                          ('intro intro) ('footer footer))
39+
                 (make-config port host database repositories validation?
40+
                              git-base-url index-title intro footer)))))
4041 
           (_ (format #t "Usage: ~a [-c config-file]~%" (car args))))))
4142 
    (run-server (gitile-handler config)
4243 
                #:port (config-port config))))