Extend edit/commit end-points to push to bare repo.

* web/view/markdown.scm: Export git-invoke.
* web/webserver.scm [+global-repo+]: Delete.
[+current-repo-path+]: New variable.
(+cgit-repo-path+): New variable.
(commit-file-handler): Commit changes to a normal repository and later
puh to the bare repository.
(controller): Uupdate "GET /edit" and "POST commit" to use the
+current-repo+.

Signed-off-by: Munyoki Kilyungi <me@bonfacemunyoki.com>

2 files changed, 31 insertions, 24 deletions

diff --git a/web/view/markdown.scm b/web/view/markdown.scm
index 3236cce..6aa2935 100644
--- a/web/view/markdown.scm
+++ b/web/view/markdown.scm
@@ -16,7 +16,7 @@
   #:use-module (web sxml)
   #:use-module (commonmark)
   #:export (markdown-file->sxml markdown-github->sxml fetch-file
-                                fetch-raw-file commit-file))
+                                fetch-raw-file commit-file git-invoke))
 
 (define (markdown-file->sxml fn)
   "Parse a local file"
diff --git a/web/webserver.scm b/web/webserver.scm
index c4ee6ca..c0fb9a1 100644
--- a/web/webserver.scm
+++ b/web/webserver.scm
@@ -27,8 +27,11 @@
              (web view doc)
              (web view markdown))
 
-(define +global-repo+
-  (getenv "REPO_PATH"))
+(define +current-repo-path+
+  (getenv "CURRENT_REPO_PATH"))
+
+(define +cgit-repo-path+
+  (getenv "CGIT_REPO_PATH"))
 
 (define +info+
   `(("name" . "GeneNetwork REST API") ("version" ,get-version)
@@ -185,25 +188,29 @@ otherwise search for set/group data"
 (define (commit-file-handler repo request body)
   (catch 'system-error
          (lambda ()
-           (let* ((post-data (decode-request-json body))
-                  (_ (for-each (lambda (target)
-                                 (invalid-data? post-data target))
-                               '("filename" "content" "username" "email"
-                                 "prev_commit")))
-                  (file-name (assoc-ref post-data "filename"))
-                  (content (assoc-ref post-data "content"))
-                  (username (assoc-ref post-data "username"))
-                  (email (assoc-ref post-data "email"))
-                  (commit-message (assoc-ref post-data "commit_message"))
-                  (prev-commit (assoc-ref post-data "prev_commit")))
-             (build-json-response 200
-                                  (commit-file repo
-                                               file-name
-                                               content
-                                               commit-message
-                                               username
-                                               email
-                                               prev-commit))))
+	   (let* ((post-data (decode-request-json body))
+		  (_ (for-each (lambda (target)
+				 (invalid-data? post-data target))
+			       '("filename" "content" "username" "email"
+				 "prev_commit")))
+		  (file-name (assoc-ref post-data "filename"))
+		  (content (assoc-ref post-data "content"))
+		  (username (assoc-ref post-data "username"))
+		  (email (assoc-ref post-data "email"))
+		  (commit-message (assoc-ref post-data "commit_message"))
+		  (prev-commit (assoc-ref post-data "prev_commit")))
+	     (build-json-response 200
+				  ((lambda ()
+				     (let ((message
+					    (commit-file +current-repo-path+
+							 file-name
+							 content
+							 commit-message
+							 username
+							 email
+							 prev-commit)))
+				       (git-invoke +current-repo-path+ "push" +cgit-repo-path+)
+				       message))))))
          (lambda (key . args)
            (let ((msg (car args)))
              (build-json-response 400
@@ -247,9 +254,9 @@ otherwise search for set/group data"
     (('GET "species")
      (render-json (get-species-meta)))
     (('GET "edit")
-     (edit-file-handler +global-repo+ request))
+     (edit-file-handler +current-repo-path+ request))
     (('POST "commit")
-     (commit-file-handler +global-repo+ request body))
+     (commit-file-handler +current-repo-path+ request body))
     (('GET id)
      (let ((names (get-species-shortnames (get-expanded-species))))
        (match (string->list id)