Megatest

Check-in [2540e2a9d9]
Login
Overview
Comment:Disallow return of eof
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | v2.0001-disallow-eof-1
Files: files | file ages | folders
SHA1: 2540e2a9d94d658298bbbc71b56133638bc57d3f
User & Date: mrwellan on 2022-02-14 19:37:59
Other Links: branch diff | manifest | tags
Context
2022-02-14
19:37
Disallow return of eof Leaf check-in: 2540e2a9d9 user: mrwellan tags: v2.0001-disallow-eof-1
19:36
Fixed double paren bug in dashboard check-in: 01de08afc5 user: mrwellan tags: v2.0001
Changes

Modified apimod.scm from [e1bfe096ff] to [eef34f67f2].

396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411



412
413
414
415
416
417
418
396
397
398
399
400
401
402

403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420







-








+
+
+







;;
(define (api:execute-requests dbstruct cmd params)
  (let* ((start-t           (current-milliseconds))
	 ;; (readonly-mode     (dbr:dbstruct-read-only dbstruct))
	 ;; (readonly-command  (member cmd api:read-only-queries))
            ;; (writecmd-in-readonly-mode (and readonly-mode (not readonly-command)))
	 (res        (api:dispatch-cmd dbstruct cmd params)))
    
    ;; (if writecmd-in-readonly-mode
    ;; (conc "attempt to run write command "cmd" on a read-only database")

    ;; save all stats
    (let ((delta-t (- (current-milliseconds)
		      start-t)))
      (hash-table-set! *db-api-call-time* cmd
		       (cons delta-t (hash-table-ref/default *db-api-call-time* cmd '()))))
    (assert (not (eof-object? res))
	    (conc "FATAL: eof not allowed as returned value. "cmd", "params))
	    
    res))

;;     (if #f ;; writecmd-in-readonly-mode
;; 	(begin
;; 	  (vector #f res))
;; 	(begin
;;              (vector #t res))))))))

Modified ulex-simple/ulex.scm from [db661a09b9] to [ccae4a1fd7].

269
270
271
272
273
274
275


276

277
278
279
280
281
282
283
284
285
286

287
288
289
290
291
292
293
269
270
271
272
273
274
275
276
277

278
279
280
281
282
283
284
285
286
287

288
289
290
291
292
293
294
295







+
+
-
+









-
+







	 (let-values (((inp oup)(tcp-connect host port)))
	   (let ((res (if (and inp oup)
			  (begin
			    (write (obj->string dat) oup)
			    ;; (write dat oup)
			    ;; (serialize dat oup)
			    (close-output-port oup)
			    (let ((inp-res (read inp)))
			      (assert (not (eof-object? inp-res)) "FATAL: returning eof not allowed. "cmd", "params)
			    (string->obj (read inp))
			      (string->obj inp-res))
			    ;; (read inp)
			    ;; (deserialize inp)
			    )
			  (begin
			    (print "ERROR: send called but no receiver has been setup. Please call setup first!")
			    #f))))
	     ;; (close-output-port oup)
	     (close-input-port inp)
	     ;; (mutex-unlock! *send-mutex*) ;; DOESN'T SEEM TO HELP
	     res)))))))) ;; res will always be 'ack unless return-method is direct
	     res))))))))

;;======================================================================
;; work queues - this is all happening on the listener side
;;======================================================================

;; move the logic to return the result somewhere else?
;;