Commit 9aec5a56 authored by Dave Cooper's avatar Dave Cooper

added aserve

parent bb1edaeb
;; Prequel to the Gnu Lesser General Public License
;; Copyright (c) 2016 Franz Inc., Berkeley, CA 94704
;; Franz Inc. has adopted the concept of the GNU Lesser General Public
;; License version 2.1 ("LGPL") to govern the use and distribution of
;; AllegroServe. However, LGPL uses terminology that is more appropriate
;; for a program written in C than one written in Lisp. Nevertheless,
;; LGPL can still be applied to a Lisp program if certain clarifications
;; are made. This document details those clarifications.
;; Accordingly, the license for AllegroServe consists of this document
;; plus LGPL. Wherever there is a conflict between this document and
;; LGPL, this document takes precedence over LGPL.
;; A "Library" in Lisp is a collection of Lisp functions, data and
;; foreign modules. The form of the Library can be Lisp source code (for
;; processing by an interpreter) or object code (usually the result of
;; compilation of source code or built with some other
;; mechanisms). Foreign modules are object code in a form that can be
;; linked into a Lisp executable. When we speak of functions we do so in
;; the most general way to include, in addition, methods and unnamed
;; functions. Lisp "data" is also a general term that includes the data
;; structures resulting from defining Lisp classes.
;; A Lisp application may include the same set of Lisp objects as does a
;; Library, but this does not mean that the application is necessarily a
;; "work based on the Library" it contains.
;; The AllegroServe Library consists of everything in the AllegroServe
;; distribution file set before any modifications are made to the files.
;; If any of the functions or classes in the AllegroServe Library are
;; redefined in other files, then those redefinitions ARE considered a
;; work based on the AllegroServe Library. If additional methods are
;; added to generic functions in the AllegroServe Library, those
;; additional methods are NOT considered a work based on the AllegroServe
;; Library. If AllegroServe classes are subclassed, these subclasses are
;; NOT considered a work based on the AllegroServe Library. If the
;; AllegroServe Library is modified to explicitly call other functions
;; that are neither part of Lisp itself nor an available add-on module to
;; Lisp, then the functions called by the modified AllegroServe Library
;; ARE considered a work based on the AllegroServe Library. The goal is
;; to ensure that the AllegroServe Library will compile and run without
;; getting undefined function errors.
;; It is permitted to add proprietary source code to the AllegroServe
;; Library, but it must be done in a way such that the AllegroServe
;; Library will still run without that proprietary code present.
;; Section 5 of the LGPL distinguishes between the case of a library
;; being dynamically linked at runtime and one being statically linked at
;; build time. Section 5 of the LGPL states that the former results in an
;; executable that is a "work that uses the Library." Section 5 of the
;; LGPL states that the latter results in one that is a "derivative of
;; the Library", which is therefore covered by LGPL. Since Lisp only
;; offers one choice, which is to link the Library into an executable at
;; build time, we declare that, for the purpose applying LGPL to the
;; AllegroServe Library, an executable that results from linking a "work
;; that uses the AllegroServe Library" with the Library is considered a
;; "work that uses the Library" and is therefore NOT covered by LGPL.
;; Because of this declaration, section 6 of LGPL is not applicable to
;; the AllegroServe Library. However, in connection with each
;; distribution of this executable, you must also deliver, in accordance
;; with the terms and conditions of the LGPL, the source code of
;; AllegroServe Library (or your derivative thereof) that is incorporated
;; into this executable.
(in-package :net.aserve)
(defun http-accept-thread ()
;; loop doing accepts and processing them
;; ignore sporatic errors but stop if we get a few consecutive ones
;; since that means things probably aren't going to get better.
(let* ((error-count 0)
(server *wserver*)
(main-socket (wserver-socket server))
(ipaddrs (wserver-ipaddrs server))
(busy-sleeps 0))
(declare (ignore ipaddrs))
(unwind-protect
(loop
(handler-case
(let ((sock (socket:accept-connection main-socket))
(localhost))
(declare (ignore localhost))
; optional.. useful if we find that sockets aren't being
; closed
(if* *watch-for-open-sockets*
then (schedule-finalization
sock
#'check-for-open-socket-before-gc))
; track all the ipaddrs by which we're reachable
#+nil
(if* (not (member (setq localhost (socket:local-host sock))
ipaddrs))
then ; new ip address by which this machine is known
(push localhost ipaddrs)
(setf (wserver-ipaddrs *wserver*) ipaddrs))
#+io-timeout
(socket:socket-control
sock
:read-timeout (wserver-io-timeout *wserver*)
:write-timeout (wserver-io-timeout *wserver*))
; another useful test to see if we're losing file
; descriptors
(if* *max-socket-fd*
then (let ((fd (excl::stream-input-fn sock)))
(if* (atomic-setf-max *max-socket-fd* fd)
then (logmess (format nil
"Maximum socket file descriptor number is now ~d" fd)))))
(setq error-count 0) ; reset count
; find a worker thread
; keep track of the number of times around the loop looking
; for one so we can handle cases where the workers are all busy
(let ((looped 0))
(loop
(multiple-value-bind (worker found-worker-p) (dequeue (wserver-free-worker-threads server) :wait 1)
(if* found-worker-p
then (incf-free-workers server -1)
(mp:process-add-run-reason worker sock)
(return)
elseif (below-max-n-workers-p server)
then (case looped
(0 nil)
((1 2 3) (logmess "all threads busy, pause")
(if* (>= (incf busy-sleeps) 4)
then ; we've waited too many times
(setq busy-sleeps 0)
(logmess "too many sleeps, will create a new thread")
(make-worker-thread)))
(4
(logmess "forced to create new thread")
(make-worker-thread))
(5
(logmess "can't even create new thread, quitting")
(return-from http-accept-thread nil)))
else (logmess "all threads busy, pause"))
(incf looped)))))
(error (cond)
(logmess (format nil "accept: error ~s on accept ~a"
error-count cond))
;; we seem to get a string of connection reset by peers,
;; perhaps due to connections that piled up before
;; we started work. So we don't want to close down
;; the accepting loop ever, thus we'll ignore the
;; code below.
#+ignore
(if* (> (incf error-count) 4)
then (logmess "accept: too many errors, bailing")
(return-from http-accept-thread nil)))))
(ignore-errors (progn
(with-locked-server (server)
(if* (eql (wserver-socket server) main-socket)
then (setf (wserver-socket server) nil)))
(close main-socket))))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment