Re: thread resource leaks if thread terminates with uncaught exception

Shiro Kawai <[email protected]> writes:

> A clue.  If we remove reference to each threads in the variable `threads`
> as follows, all VMs are finalized and the next gc closes opened fds.
>
> ```
>           (cond [(not body)
>                  (for-each thread-terminate! threads)
>                  (let loop ((threads threads))
>                    (unless (null? threads)
>                      (set-car! threads #f)
>                      (loop (cdr threads))))
> ```
>
> Merely nulling the variable `threads` doesn't work.  So somebody's grabbing
> the head of thread list itself, preventing them from being GC-ed.

I am still playing around with this and the code above fixes the
problems most of the time. But I also see strange effects I don't
understand with slight changes to the reverse proxy code and I can
provoke it failing after some time again using quite many threads and a
very small timeout. The reverse proxy version below just failed after 5
minutes. Anyway I still don't want to give up and return to a fork based
approach.

#!/bin/sh
#| -*- mode: scheme; coding: utf-8; -*-
#export GC_PRINT_STATS=1
exec gosh -I. -- $0 "$@"
|#
(use makiki)
(use text.html-lite)
(use rfc.http)
(use gauche.threads)
(use file.util)
(use gauche.sequence)

;; todo: linux specific
(define (num-open-files)
  (guard (e
	  [else
	   +nan.0])
	 (length (directory-list "/proc/self/fd" :children? #t))))

(define (num-threads)
  (guard (e
	  [else
	   +nan.0])
	 (length (directory-list "/proc/self/task" :children? #t))))

(define-http-handler (GET) "/" (^[req app]
				 (receive (status headers body)
				     (http-get "localhost:8081" "/")
				   (respond/ok req body))))

(define (http-get-body)
  (receive (status headers body)
      ;; todo: detect host name and use it to force a real dns lookup
      ;; to occur?
      (http-get "localhost:8081" "/slow")
    body))

(define-http-handler (GET)
  "/timeout"
  (lambda(req app)
    (let1 threads (map (lambda(i)
			 (make-thread http-get-body))
		       (iota 400))
      (for-each thread-start! threads)
      ;;#?=(num-threads)
      (let1 timeout (absolute-time 0.01)
	(let1 body
	    (guard (e
		    [(uncaught-exception-condition? e)
		     #?=(uncaught-exception-condition-reason e)]
		    [else #?=e])
		   (thread-join! (car threads) timeout #f))
	  (for-each
	   (lambda(t)
	     (guard (e
		     [(uncaught-exception-condition? e)
		      #?=(uncaught-exception-condition-reason e)]
		     [else #?=e])
		    (thread-join! t timeout #f)))
	   (cdr threads))
	  (cond [(not body)
		 ;; note: we don't need force here
		 (for-each thread-terminate! threads)
		 ;; otherwise we get thread died a lonely death with
		 ;; an uncaught exception in the error case
		 (for-each-with-index
		  (lambda(i t)
		    (guard (e [(terminated-thread-exception? e)
			       #t]
			      [else
			       #?=(list i e)])
			   (thread-join! t)))
		  threads)
		 ;; help gc cleanup (this fixes the problem? at least
		 ;; if the timeout isn't too small)
		 (let loop ((threads threads))
                   (unless (null? threads)
                     (set-car! threads #f)
                     (loop (cdr threads))))
		 ;;#?=(num-threads)
		 (respond/ok req
			     (list
			      (html-doctype)
			      (html:html
			       (html:head (html:title "timeout"))
			       (html:body
				(html:p "timeout")
				(html:p
				 (string-append
				  (x->string (num-open-files))
				  " open files"))))))]
		[else
		 body]))))))

(define (main args)
  #?=(sys-getpid)
  (debug-print-width 4000)
  (start-http-server :port 8080 :error-log #t)
  0)