File: netcgi_apache_mod.ml.in

package info (click to toggle)
ocamlnet 4.1.2-1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 51,764 kB
  • ctags: 16,446
  • sloc: ml: 148,419; ansic: 10,989; sh: 1,885; makefile: 1,355
file content (627 lines) | stat: -rw-r--r-- 24,256 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
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
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
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
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
(* netcgi_apache_mod.ml

   Copyright (C) 2005-2007

     Christophe Troestler
     email: Christophe.Troestler@umh.ac.be
     WWW: http://math.umh.ac.be/an/

   This library is free software; see the file LICENSE for more information.

   This library is distributed in the hope that it will be useful, but
   WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the file
   LICENSE for more details.
*)

(* This is a module with minimal dependencies to embed the ocaml
   runtime into Apache.  Together with some C bindings it will make
   the mod_netcgi.so Apache module.  The Netcgi_apache will then be
   loaded (with ist dependencies) using Apache directives. *)

(** Configuration settings. *)
module Conf =
struct
  let ocaml_libdir = "@APACHE_OCAMLLIBDIR@"
  let package = "@PKGNAME@"
  let version = "@VERSION@"
  let apache_libdir = "@APACHE_LIBDIR@"
  let apache_major = @APACHE_MAJOR@

  let gateway_interface = "Netcgi_apache"
  let server_software =
    String.concat "" ["Apache/"; Filename.basename apache_libdir;
                      " "; gateway_interface; "/"; version]
end

(* We do not want to use the Netcgi_apache one because we want minimal
   dependencies. *)
let log_error msg =
  let t = Unix.localtime(Unix.time()) in
  let dow = [| "Sun"; "Mon"; "Tue"; "Wed"; "Thu"; "Fri";
               "Sat" |].(t.Unix.tm_wday)
  and month = [| "Jan"; "Feb"; "Mar"; "Apr"; "May"; "Jun"; "Jul"; "Aug";
                 "Sep"; "Oct"; "Nov"; "Dec" |].(t.Unix.tm_mon) in
  Printf.eprintf "[%s %s %d %02d:%02d:%02d %d] [Netcgi_apache_mod] %s\n%!"
    dow month t.Unix.tm_mday  t.Unix.tm_hour t.Unix.tm_min t.Unix.tm_sec
    (t.Unix.tm_year + 1900) msg




(* One has at least to use the apache.c functions here so they are
   part of the dynamic library. *)
module Raw_Apache =
struct
  (* Forked from mod_caml on May 29, 2006. *)

  module Table = struct (* Table functions. *)
    type t
    external clear : t -> unit			= "netcgi2_apache_table_clear"
    external get : t -> string -> string	= "netcgi2_apache_table_get"
    external get_all : t -> string -> string list
      = "netcgi2_apache_table_get_all"
    external fields : t -> (string * string) list
      = "netcgi2_apache_table_fields"
    external set : t -> string -> string -> unit	= "netcgi2_apache_table_set"
    external add : t -> string -> string -> unit	= "netcgi2_apache_table_add"
    external unset : t -> string -> unit	= "netcgi2_apache_table_unset"

  (*
    Non-copying version. Not a great idea to allow access to this.
    external setn : t -> string -> string -> unit = "netcgi2_apache_table_setn"
  *)

  (* ... etc ... *)
  end

  module Server = struct  (* Server_rec functions. *)
    type t				(* Actual server_rec structure. *)
    external hostname : t -> string 	= "netcgi2_apache_server_hostname"
    external admin : t -> string	= "netcgi2_apache_server_admin"
    external is_virtual : t -> bool	= "netcgi2_apache_server_is_virtual"

  (* ... etc ... *)
  end

  module Connection = (* Conn_rec functions. *)
  struct
    type t				(* Actual conn_rec structure. *)

    external remote_ip : t -> string = "netcgi2_apache_connection_remote_ip"
    external remote_host : t -> string = "netcgi2_apache_connection_remote_host"

  (* ... etc ... *)
  end

  module Request = struct (* Request_rec functions. *)
    type t (* request_rec structure. *)

    external connection : t -> Connection.t
      = "netcgi2_apache_request_connection"
    external server : t -> Server.t	= "netcgi2_apache_request_server"
    external next : t -> t		= "netcgi2_apache_request_next"
    external prev : t -> t		= "netcgi2_apache_request_prev"
    external main : t -> t		= "netcgi2_apache_request_main"
    external the_request : t -> string	= "netcgi2_apache_request_the_request"
    external assbackwards : t -> bool	= "netcgi2_apache_request_assbackwards"

    external header_only : t -> bool	= "netcgi2_apache_request_header_only"
    external protocol : t -> string	= "netcgi2_apache_request_protocol"
    external proto_num : t -> int	= "netcgi2_apache_request_proto_num"
    external hostname : t -> string	= "netcgi2_apache_request_hostname"
    external request_time : t -> float	= "netcgi2_apache_request_request_time"
    external status_line : t -> string	= "netcgi2_apache_request_status_line"
    external set_status_line : t -> string -> unit
      = "netcgi2_apache_request_set_status_line"
    external status : t -> int		  = "netcgi2_apache_request_status"
    external set_status : t -> int -> unit = "netcgi2_apache_request_set_status"
    external method_name : t -> string	  = "netcgi2_apache_request_method"
    external method_number : t -> int = "netcgi2_apache_request_method_number"
    let request_methods =
      [| `GET; `PUT; `POST; `DELETE; `CONNECT; `OPTIONS; `TRACE; `PATCH;
         `PROPFIND; `PROPPATCH; `MKCOL; `COPY; `MOVE; `LOCK; `UNLOCK;
         `INVALID |]
    let method_number r =
      let n = method_number r in
      if n < 0 || n >= Array.length request_methods then assert false;
      Array.unsafe_get request_methods n

    external headers_in : t -> Table.t	  = "netcgi2_apache_request_headers_in"
    external headers_out : t -> Table.t	  = "netcgi2_apache_request_headers_out"
    external err_headers_out : t -> Table.t
      = "netcgi2_apache_request_err_headers_out"
    external subprocess_env : t -> Table.t
      = "netcgi2_apache_request_subprocess_env"
    external notes : t -> Table.t	  = "netcgi2_apache_request_notes"
    external content_type : t -> string = "netcgi2_apache_request_content_type"
    external set_content_type : t -> string -> unit
      = "netcgi2_apache_request_set_content_type"

    external uri : t -> string		  = "netcgi2_apache_request_uri"
    external port : t -> int		  = "netcgi2_apache_request_port"
    external set_uri : t -> string -> unit = "netcgi2_apache_request_set_uri"
    external filename : t -> string	  = "netcgi2_apache_request_filename"
    external set_filename : t -> string -> unit
      = "netcgi2_apache_request_set_filename"
    external path_info : t -> string	  = "netcgi2_apache_request_path_info"
    external set_path_info : t -> string -> unit
      = "netcgi2_apache_request_set_path_info"
    external args : t -> string		  = "netcgi2_apache_request_args"
    external set_args : t -> string -> unit = "netcgi2_apache_request_set_args"
    external finfo : t -> Unix.stats option = "netcgi2_apache_request_finfo"

    type read_policy = NO_BODY
                       | CHUNKED_ERROR
		       | CHUNKED_DECHUNK
		       | CHUNKED_PASS

    external setup_client_block : t -> read_policy -> int
      = "netcgi2_apache_request_setup_client_block"

    external should_client_block : t -> bool
      = "netcgi2_apache_request_should_client_block"
    external get_client_block : t -> string
      = "netcgi2_apache_request_get_client_block"
    external get_client_block_buffer : t -> Bytes.t -> int -> int -> int
      = "netcgi2_apache_request_get_client_block_buffered"
    external discard_request_body : t -> int
      = "netcgi2_apache_request_discard_request_body"

    external user : t -> string		  = "netcgi2_apache_request_user"
      (* In Apache 1.3 this field is actually in the [conn_rec]
         structure, and was moved here in Apache 2.0.  We
         transparently hide this detail for you. *)
    external auth_type : t -> string = "netcgi2_apache_auth_type"
    external note_auth_failure : t -> unit
      = "netcgi2_apache_request_note_auth_failure"
    external note_basic_auth_failure : t -> unit
      = "netcgi2_apache_request_note_basic_auth_failure"
    external note_digest_auth_failure : t -> unit
      = "netcgi2_apache_request_note_digest_auth_failure"
    external get_basic_auth_pw : t -> int * string option
      = "netcgi2_apache_request_get_basic_auth_pw"

    external send_http_header : t -> unit
      = "netcgi2_apache_request_send_http_header"
    external rflush : t -> int		= "netcgi2_apache_request_rflush"

    external internal_redirect : string -> t -> unit
      = "netcgi2_apache_request_internal_redirect"
    external internal_redirect_handler : string -> t -> unit
      = "netcgi2_apache_request_internal_redirect_handler"

    external print_char : t -> char -> unit
      = "netcgi2_apache_request_print_char"

    external unsafe_output : t -> Bytes.t -> int -> int -> int
      = "netcgi2_apache_request_output"
    let output r s ofs len =
      if ofs < 0 || len < 0 || ofs + len > Bytes.length s then
        invalid_arg "Netcgi_apache.Apache.Request.output";
      unsafe_output r s ofs len

    let print_string r s =
      let s = Bytes.unsafe_of_string s in
      let n = Bytes.length s in
      let i = ref 0 in
      while !i < n do
        let w = unsafe_output r s !i (n - !i) in
        if w <= 0 then failwith "print_string: end of file or error";
        i := !i + w;
      done

    let print_int r i =     print_string r (string_of_int i)
    let print_float r f =   print_string r (string_of_float f)
    let print_newline r =   print_string r "\r\n"
    let print_endline r s = print_string r s; print_newline r

    (* ... etc ... *)

    external register_cleanup : t -> (unit -> unit) -> unit
      = "netcgi2_apache_request_register_cleanup"
  end


  (* Unless we actually reference the external C functions, OCaml
     doesn't load them into the primitive table and we won't be able to
     access them!  *)
  let _table_clear = Table.clear
  let _table_get = Table.get
  let _table_get_all = Table.get_all
  let _table_fields = Table.fields
  let _table_set = Table.set
  let _table_add = Table.add
  let _table_unset = Table.unset

  let _server_hostname = Server.hostname
  let _server_admin = Server.admin
  let _server_is_virtual = Server.is_virtual

  let _connection_remote_ip = Connection.remote_ip
  let _connection_remote_host = Connection.remote_host

  let _request_connection = Request.connection
  let _request_server = Request.server
  let _request_next = Request.next
  let _request_prev = Request.prev
  let _request_main = Request.main
  let _request_the_request = Request.the_request
  let _request_assbackwards = Request.assbackwards
  let _request_header_only = Request.header_only
  let _request_protocol = Request.protocol
  let _request_proto_num = Request.proto_num
  let _request_hostname = Request.hostname
  let _request_request_time = Request.request_time
  let _request_status_line = Request.status_line
  let _request_set_status_line = Request.set_status_line
  let _request_status = Request.status
  let _request_set_status = Request.set_status
  let _request_method_name = Request.method_name
  let _request_method_number = Request.method_number
  let _request_headers_in = Request.headers_in
  let _request_headers_out = Request.headers_out
  let _request_err_headers_out = Request.err_headers_out
  let _request_subprocess_env = Request.subprocess_env
  let _request_notes = Request.notes
  let _request_content_type = Request.content_type
  let _request_set_content_type = Request.set_content_type
  let _request_uri = Request.uri
  let _request_port = Request.port
  let _request_set_uri = Request.set_uri
  let _request_filename = Request.filename
  let _request_set_filename = Request.set_filename
  let _request_path_info = Request.path_info
  let _request_set_path_info = Request.set_path_info
  let _request_args = Request.args
  let _request_set_args = Request.set_args
  let _request_finfo = Request.finfo
  let _request_setup_client_block = Request.setup_client_block
  let _request_should_client_block = Request.should_client_block
  let _request_get_client_block = Request.get_client_block
  let _request_get_client_block_buffer = Request.get_client_block_buffer
  let _request_discard_request_body = Request.discard_request_body
  let _request_user = Request.user
  let _request_auth_type = Request.auth_type
  let _request_note_auth_failure = Request.note_auth_failure
  let _request_note_basic_auth_failure = Request.note_basic_auth_failure
  let _request_note_digest_auth_failure = Request.note_digest_auth_failure
  let _request_get_basic_auth_pw = Request.get_basic_auth_pw
  let _request_send_http_header = Request.send_http_header
  let _request_rflush = Request.rflush
  let _request_internal_redirect = Request.internal_redirect
  let _request_internal_redirect_handler = Request.internal_redirect_handler
  let _request_print_char = Request.print_char
  let _request_unsafe_output = Request.unsafe_output
  let _request_register_cleanup = Request.register_cleanup
end (* module Raw_Apache ------------------------------------------------- *)


module Handler =
struct
  (* Forked from mod_caml.ml but streamlined and adapted to Netcgi2 style. *)

  type result = OK | DECLINED | DONE | HTTP of int

  type t = Raw_Apache.Request.t -> result
    (* Handler on the Caml side.  May also exit through an exception. *)

  (*----- Initialize Dynlink library. -----*)

  let () =
    try
      Dynlink.init ();
      Dynlink.allow_unsafe_modules true
    with
      Dynlink.Error(e) -> failwith(Dynlink.error_message e)

  (*----- Configuration. -----*)

  type dir_config_t = {
    location : string option;
    check_user_id : t option;
    auth_checker : t option;
    access_checker : t option;
    type_checker : t option;
    fixer_upper : t option;
    logger : t option;
    header_parser : t option;
    post_read_request : t option;
    ocaml_bytecode_handler : t option;
  }

  type server_config_t = {
    translate_handler : t option;
  }

  let create_dir_config dirname =
    { location = dirname;
      check_user_id = None;
      auth_checker = None;
      access_checker = None;
      type_checker = None;
      fixer_upper = None;
      logger = None;
      header_parser = None;
      post_read_request = None;
      ocaml_bytecode_handler = None }

  let update b a = if a = None then b else a

  let merge_dir_config base add =
    {
      location = 	update base.location add.location;
      check_user_id = 	update base.check_user_id add.check_user_id;
      auth_checker = 	update base.auth_checker add.auth_checker;
      access_checker = 	update base.access_checker add.access_checker;
      type_checker = 	update base.type_checker add.type_checker;
      fixer_upper = 	update base.fixer_upper add.fixer_upper;
      logger = 		update base.logger add.logger;
      header_parser = 	update base.header_parser add.header_parser;
      post_read_request = update base.post_read_request add.post_read_request;
      ocaml_bytecode_handler =
        update base.ocaml_bytecode_handler add.ocaml_bytecode_handler;
    }

  external get_dir_config : Raw_Apache.Request.t -> dir_config_t
    = "netcgi2_apache_get_dir_config" (* in apache.c *)

  let create_server_config s =
    { translate_handler = None; }

  let merge_server_config base add =
    { translate_handler = update base.translate_handler add.translate_handler }

  external get_server_config : Raw_Apache.Request.t -> server_config_t
    = "netcgi2_apache_get_server_config" (* in apache.c *)

  let () =
    Callback.register "netcgi2_apache_create_dir_config"    create_dir_config;
    Callback.register "netcgi2_apache_merge_dir_config"     merge_dir_config;
    Callback.register "netcgi2_apache_create_server_config"
      create_server_config;
    Callback.register "netcgi2_apache_merge_server_config"  merge_server_config


  (*----- Handlers. -----*)

  (** [make_handler name conf_member] register a function that, when
      executed (on the C side), will run the handler set in the
      configuration if any is present. *)
  let make_handler name conf =
    (* This function returns an integer (DECLINED -1, DONE -2, OK 0 or
       an HTTP status) so we can deal with exceptions on the Caml side. *)
    let handler r =
      try
        match conf r with
        | Some handler ->
            (try
                match handler r with
                | OK -> 0
                | DECLINED -> -1
                | DONE -> -2
                | HTTP i -> i
              with
              | Exit -> 0 (* = OK; considered a correct way to terminate *)
              | exn ->
                  log_error(name ^ ": Uncaught exception: "
                             ^ Printexc.to_string exn);
                  500 (* Internal Server Error *)
            )
        | None -> -1 (* DECLINED; no handler *)
      with Not_found -> -1 (* DECLINED; no server config *)
    in
    Callback.register name (handler:Raw_Apache.Request.t -> int)

  let () =
    make_handler "netcgi2_apache_translate_handler"
      (fun r -> (get_server_config r).translate_handler);
    make_handler "netcgi2_apache_check_user_id"
      (fun r -> (get_dir_config r).check_user_id);
    make_handler "netcgi2_apache_auth_checker"
      (fun r -> (get_dir_config r).auth_checker);
    make_handler "netcgi2_apache_access_checker"
      (fun r -> (get_dir_config r).access_checker);
    make_handler "netcgi2_apache_type_checker"
      (fun r -> (get_dir_config r).type_checker);
    make_handler "netcgi2_apache_fixer_upper"
      (fun r -> (get_dir_config r).fixer_upper);
    make_handler "netcgi2_apache_logger"
      (fun r -> (get_dir_config r).logger);
    make_handler "netcgi2_apache_header_parser"
      (fun r -> (get_dir_config r).header_parser);
    make_handler "netcgi2_apache_post_read_request"
      (fun r -> (get_dir_config r).post_read_request);
    make_handler "netcgi2_apache_ocaml_bytecode_handler"
      (fun r -> (get_dir_config r).ocaml_bytecode_handler)


  (*----- Handler registration. -----*)

  let reg_table = Hashtbl.create 16

  let reg_module_name = ref None

  let register_module handler full_name =
    Hashtbl.replace reg_table full_name handler

  (* Register the module's handler. *)
  let register (handler:t) name =
    match !reg_module_name with
    | None ->
        failwith("Netcgi_apache.Handler.register: \
		 call outside module initialization")
    | Some module_name -> register_module handler (module_name ^ "." ^ name)

  (*----- Commands. -----*)

  (* NetcgiLoad [filename].  Preprend the ocaml standard library path
     (ocamlc -where) if [filename] is relative. *)
  let cmd_load filename =
    let filename =
      if Filename.is_relative filename then
        Filename.concat Conf.ocaml_libdir filename
      else filename in
    reg_module_name := Some(String.capitalize(Filename.chop_extension
                                               (Filename.basename filename)));
    try  Dynlink.loadfile filename;
    with Dynlink.Error(e) ->
      log_error(Dynlink.error_message e)

  let skip_findlib = [ "unix"; "dynlink"; "findlib" ]
  let predicates = ref [ "byte" ]
  let loaded = ref []
  let init_findlib_var = ref false

  let init_findlib() =
    if not !init_findlib_var then (
      Findlib.init();
      init_findlib_var := true
    )

  let split_in_words s =
    (* Copy of Fl_split.in_words.
       splits s in words separated by commas and/or whitespace *)
    let l = String.length s in
    let rec split i j =
      if j < l then
	match s.[j] with
            (' '|'\t'|'\n'|'\r'|',') ->
              if i<j then (String.sub s i (j-i)) :: (split (j+1) (j+1))
              else split (j+1) (j+1)
	  | _ ->
              split i (j+1)
      else
	if i<j then [ String.sub s i (j-i) ] else []
    in
    split 0 0

  let cmd_require pkg =
    (* Findlib-supported package loading. Also see topfind.ml in findlib *)
    init_findlib();
    try
      let eff_pkglist =
	Findlib.package_deep_ancestors !predicates [pkg] in
      List.iter
	(fun pkg ->
	   if not (List.mem pkg !loaded) then begin
             (* Determine the package directory: *)
             let d = Findlib.package_directory pkg in
             if not (List.mem pkg skip_findlib) then begin
               (* Determine the 'archive' property: *)
               let archive =
		 try Findlib.package_property !predicates pkg "archive"
		 with
		     Not_found -> ""
               in
               (* Split the 'archive' property and load the files: *)
               let archives = split_in_words archive in
               List.iter
		 (fun arch -> 
		    let arch' = Findlib.resolve_path ~base:d arch in
		    reg_module_name := 
		      Some(String.capitalize(Filename.chop_extension
					       (Filename.basename arch')));
		    try Dynlink.loadfile arch';
		    with Dynlink.Error(e) ->
		      log_error(Dynlink.error_message e)
		 )
		 archives;
             end;
             (* The package is loaded: *)
             loaded := pkg :: !loaded
	   end
	)
	eff_pkglist
    with
      | Findlib.No_such_package(name,_) ->
	  log_error ("No such ocaml package: " ^ name)
      | Findlib.Package_loop name ->
	  log_error ("Ocaml package loop: " ^ name)
      | Failure msg ->
	  log_error ("Failure: " ^ msg)

  let cmd_thread _ =
    init_findlib();
    let have_mt_support() =
      Findlib.package_property [] "threads" "type_of_threads" = "posix" in
      if not(List.mem "threads" !loaded) then (
	(* This works only for POSIX threads. *)
	if have_mt_support() then (
	  predicates := ["mt"; "mt_posix"] @ !predicates;
	  cmd_require "threads"
	)
	else (
	  log_error "NetcgiThread: No support for threads"
	)
      )

  let cmd_predicates s =
    init_findlib();
    let preds = split_in_words s in
    predicates := preds @ !predicates

  let cmd_translate_handler sconfig name =
    { sconfig with translate_handler = Some (Hashtbl.find reg_table name) }

  let cmd_check_user_id_handler dconfig name =
    { dconfig with check_user_id = Some (Hashtbl.find reg_table name) }

  let cmd_auth_checker_handler dconfig name =
    { dconfig with auth_checker = Some (Hashtbl.find reg_table name) }

  let cmd_access_checker_handler dconfig name =
    { dconfig with access_checker = Some (Hashtbl.find reg_table name) }

  let cmd_type_checker_handler dconfig name =
    { dconfig with type_checker = Some (Hashtbl.find reg_table name) }

  let cmd_fixer_upper_handler dconfig name =
    { dconfig with fixer_upper = Some (Hashtbl.find reg_table name) }

  let cmd_logger_handler dconfig name =
    { dconfig with logger = Some (Hashtbl.find reg_table name) }

  let cmd_header_parser_handler dconfig name =
    { dconfig with header_parser = Some (Hashtbl.find reg_table name) }

  let cmd_post_read_request_handler dconfig name =
    { dconfig with post_read_request = Some (Hashtbl.find reg_table name) }

  let cmd_handler dconfig name =
    { dconfig with ocaml_bytecode_handler = Some (Hashtbl.find reg_table name) }

  let () =
    let cb = Callback.register in
    cb "netcgi2_apache_cmd_load"                   cmd_load;
    cb "netcgi2_apache_cmd_require"                cmd_require;
    cb "netcgi2_apache_cmd_thread"                 cmd_thread;
    cb "netcgi2_apache_cmd_predicates"             cmd_predicates;
    cb "netcgi2_apache_cmd_translate_handler"      cmd_translate_handler;
    cb "netcgi2_apache_cmd_check_user_id_handler"  cmd_check_user_id_handler;
    cb "netcgi2_apache_cmd_auth_checker_handler"   cmd_auth_checker_handler;
    cb "netcgi2_apache_cmd_access_checker_handler" cmd_access_checker_handler;
    cb "netcgi2_apache_cmd_type_checker_handler"   cmd_type_checker_handler;
    cb "netcgi2_apache_cmd_fixer_upper_handler"    cmd_fixer_upper_handler;
    cb "netcgi2_apache_cmd_logger_handler"         cmd_logger_handler;
    cb "netcgi2_apache_cmd_header_parser_handler"  cmd_header_parser_handler;
    cb "netcgi2_apache_cmd_post_read_request_handler"
      cmd_post_read_request_handler;
    cb "netcgi2_apache_cmd_handler"                cmd_handler

end (* module Handler ------------------------------------------------- *)


(** Support for classes.  Unless we use classes here, the support for
    classes will not be embedded in apache and loading Netcgi will fail. *)
class _support__classes_ = object end

(** There is no lazy.cma, lexing.cma, stream.cma,... to load.
    Reference these modules here to make sure they are included in the
    module hence the mod .so *)
let _arg_parse_ = Arg.parse
let _lazy_force_ = Lazy.force
let _lexing_lexeme_ = Lexing.lexeme
let _queue_create_ = Queue.create
let _stack_create_ = Stack.create
let _stream_sempty_ = Stream.sempty