implement project cancel
This commit is contained in:
parent
b6ece4abcc
commit
18381a5e01
crossfire
|
@ -178,6 +178,7 @@
|
|||
(number->string (car ppe) 16)
|
||||
(number->string (cdr ppe) 16)))))
|
||||
|
||||
;; TODO : handle stdio mode lol
|
||||
(define-values [proc out in _]
|
||||
(parameterize ([current-custodian cust] [current-directory extract-dir])
|
||||
(apply subprocess #f #f (current-error-port) 'new (append cmd args))))
|
||||
|
|
|
@ -30,6 +30,7 @@
|
|||
new-project
|
||||
get-projects
|
||||
get-project-file
|
||||
delete-project
|
||||
agent-report-state])
|
||||
|
||||
(define-signature agent^
|
||||
|
|
|
@ -108,6 +108,8 @@
|
|||
(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-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
|
||||
"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"))])
|
||||
(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
|
||||
|
||||
|
|
Loading…
Reference in New Issue