(use-modules (alterator pipe)

             (alterator http template)
             (alterator http html)

             (alterator configd html)
             (alterator configd woo)
             (alterator configd form)
             (alterator configd constraints)
             (alterator configd frontend))

(define (fix-url veid url)
  (string-append "/ovz-proxy/" veid url))

(define (not-href? x)
  (not (eq? (car x) 'href)))

(define (fix-local-refs veid)
  (lambda(scm)
    (scm-filter
     scm
     (make-cb
      (replace-tag: "local:a"
                    (lambda (options content)
                      `(local:a
                        ,(@ 'href (fix-url veid (cond-assoc 'href options)))
                        ,@(filter not-href? options)
                        ,@content)))))))

(define (insert-menu veid _)
  (lambda(scm)
    (scm-filter
     scm
     (make-cb
      (replace-tag: "div"
                    (@ 'id "hostinfo")
                    (html: "div"
                           (_ "Inside virtual appliance") " " veid
                           ":"
                           `(local:a  ,(@ 'href "/ovz-ve")
			              ,(_ "return to hardware node"))))))))

(define (redirect? answer)
  (and (pair? answer) (eq? (car answer) 'redirect)))

(define (ovz-proxy objects action url-args template-args)
  (let ((_ (make-translator "alterator-ovz" (cond-assoc "language" url-args '("en_US")))))
    (catch
        #t
      (thunk
       (let* ((veid (cond-cadr objects))
              (url (string-append "/" (string-join (cddr objects) "/")))
              (gate (create-process 'read-write "/usr/sbin/vzctl" "exec" veid "alterator" "-c" "fbi-stdin.layout"))
              (i-port (port-for-read gate))
              (o-port (port-for-write gate))
              (url-args (append1 url-args (cons "action" action))))
         
         (write (list (if (string=? action "read") "get" "post")
                      url
                      url-args)
                o-port)
         (let ((answer (read i-port)))
           (stop-process 'terminate gate)
           (cond
            ((redirect? answer)
             `(redirect ,(fix-url veid (cadr answer))))
            (else
             (cons 'quote
                   ((compose (insert-menu veid _)
                             (fix-local-refs veid))
                    answer)))))))
      (lambda args
              (woo-throw (_ "configurator not found"))))))
  
(lambda (self objects options)
  (list
   'scm
   (ovz-proxy objects
              (cond-plistq 'action options)
              (cond-plistq 'url-args options)
              (cond-plistq 'template-args options))))

