implement project cancel
This commit is contained in:
parent
b6ece4abcc
commit
18381a5e01
|
@ -178,6 +178,7 @@
|
||||||
(number->string (car ppe) 16)
|
(number->string (car ppe) 16)
|
||||||
(number->string (cdr ppe) 16)))))
|
(number->string (cdr ppe) 16)))))
|
||||||
|
|
||||||
|
;; TODO : handle stdio mode lol
|
||||||
(define-values [proc out in _]
|
(define-values [proc out in _]
|
||||||
(parameterize ([current-custodian cust] [current-directory extract-dir])
|
(parameterize ([current-custodian cust] [current-directory extract-dir])
|
||||||
(apply subprocess #f #f (current-error-port) 'new (append cmd args))))
|
(apply subprocess #f #f (current-error-port) 'new (append cmd args))))
|
||||||
|
|
|
@ -30,6 +30,7 @@
|
||||||
new-project
|
new-project
|
||||||
get-projects
|
get-projects
|
||||||
get-project-file
|
get-project-file
|
||||||
|
delete-project
|
||||||
agent-report-state])
|
agent-report-state])
|
||||||
|
|
||||||
(define-signature agent^
|
(define-signature agent^
|
||||||
|
|
|
@ -108,6 +108,8 @@
|
||||||
(define-stmt q-delete-task "delete from task where id=?")
|
(define-stmt q-delete-task "delete from task where id=?")
|
||||||
(define-stmt q-get-tasks "select id, name, manifest, complete from task")
|
(define-stmt q-get-tasks "select id, name, manifest, complete from task")
|
||||||
(define-stmt q-set-task-complete "update task set complete=1 where id=?")
|
(define-stmt q-set-task-complete "update task set complete=1 where id=?")
|
||||||
|
(define-stmt q-task-exists "select 1 from task where id=?")
|
||||||
|
(define-stmt q-delete-task "delete from task where id=?")
|
||||||
|
|
||||||
(define-stmt q-get-task-log
|
(define-stmt q-get-task-log
|
||||||
"select worker, time_wall_start, duration, pattern from task_log where taskid=?")
|
"select worker, time_wall_start, duration, pattern from task_log where taskid=?")
|
||||||
|
@ -319,6 +321,17 @@
|
||||||
(with-handlers ([exn:fail? (lambda (ex) (error "unable to fetch the requested file"))])
|
(with-handlers ([exn:fail? (lambda (ex) (error "unable to fetch the requested file"))])
|
||||||
(server-get-file taskid)))
|
(server-get-file taskid)))
|
||||||
|
|
||||||
|
(define/contract (cancel-project taskid)
|
||||||
|
(-> integer? void?)
|
||||||
|
(enforce-subject 'client)
|
||||||
|
(call-with-transaction (current-db) (lambda ()
|
||||||
|
(define exist (query-maybe-value (current-db) q-task-exists taskid))
|
||||||
|
(when exist
|
||||||
|
(agent-handler-cancel-task taskid)
|
||||||
|
(query-exec (current-db) q-delete-task taskid))))
|
||||||
|
(define path (get-project-file-path taskid))
|
||||||
|
(when (file-exists? path)
|
||||||
|
(delete-file path)))
|
||||||
|
|
||||||
;; agent handling
|
;; agent handling
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue