implement project cancel

crossfire/agent.rkt

@@ -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))))

crossfire/protocol.rkt

@@ -30,6 +30,7 @@
    new-project
    get-projects
    get-project-file
+   delete-project
    agent-report-state])
 
 (define-signature agent^

crossfire/server.rkt

@@ -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