← Back to branch summary

~ubuntu-branches/ubuntu/trusty/ocamlnet/trusty

« back to all changes in this revision

Viewing changes to src/netclient/telnet_client.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-09-02 14:12:33 UTC
  • mfrom: (18.2.3 sid)
  • Revision ID: james.westby@ubuntu.com-20110902141233-zbj0ygxb92u6gy4z
Tags: 3.4-1
http://bugs.debian.org/637147
* New upstream release
  - add a new NetcgiRequire directive to ease dependency management
    (Closes: #637147)
  - remove patches that were applied upstream:
    + Added-missing-shebang-lines-in-example-shell-scripts
    + Try-also-ocamlc-for-POSIX-threads

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/netclient/telnet_client.ml
1
 
(* $Id: telnet_client.ml 1121 2007-05-06 18:20:37Z gerd $
 
1
(* $Id: telnet_client.ml 1614 2011-06-09 15:08:56Z gerd $
2
2
 * ----------------------------------------------------------------------
3
3
 *
4
4
 *)
17
17
 *   more complicated.
18
18
 *)
19
19
 
 
20
module Debug = struct
 
21
  let enable = ref false
 
22
end
 
23
 
 
24
let dlog = Netlog.Debug.mk_dlog "Ftp_client" Debug.enable
 
25
let dlogr = Netlog.Debug.mk_dlogr "Ftp_client" Debug.enable
 
26
 
 
27
let () =
 
28
  Netlog.Debug.register_module "Ftp_client" Debug.enable
 
29
 
 
30
 
 
31
 
20
32
exception Telnet_protocol of exn;;
21
33
 
 
34
let () =
 
35
  Netexn.register_printer
 
36
    (Telnet_protocol Not_found)
 
37
    (fun e ->
 
38
       match e with
 
39
         | Telnet_protocol e' ->
 
40
             "Telnet_client.Telnet_protocol(" ^ Netexn.to_string e' ^ ")"
 
41
         | _ ->
 
42
             assert false
 
43
    )
 
44
 
22
45
 
23
46
type telnet_command =
24
47
    Telnet_data of string
45
68
 
46
69
let prerr_command cmd =
47
70
  match cmd with
48
 
      Telnet_data s    -> prerr_endline ("Telnet: Data " ^ s)
49
 
    | Telnet_nop       -> prerr_endline "Telnet: NOP";
50
 
    | Telnet_dm        -> prerr_endline "Telnet: DM";
51
 
    | Telnet_brk       -> prerr_endline "Telnet: BRK";
52
 
    | Telnet_ip        -> prerr_endline "Telnet: IP";
53
 
    | Telnet_ao        -> prerr_endline "Telnet: AO";
54
 
    | Telnet_ayt       -> prerr_endline "Telnet: AYT";
55
 
    | Telnet_ec        -> prerr_endline "Telnet: EC";
56
 
    | Telnet_el        -> prerr_endline "Telnet: EL";
57
 
    | Telnet_ga        -> prerr_endline "Telnet: GA";
58
 
    | Telnet_sb c      -> prerr_endline ("Telnet: DB " ^ 
59
 
                                         string_of_int(Char.code c));
60
 
    | Telnet_se        -> prerr_endline "Telnet: SE";
61
 
    | Telnet_will c    -> prerr_endline ("Telnet: WILL " ^
62
 
                                         string_of_int(Char.code c));
63
 
    | Telnet_wont c    -> prerr_endline ("Telnet: WONT " ^
64
 
                                         string_of_int(Char.code c));
65
 
    | Telnet_do c      -> prerr_endline ("Telnet: DO " ^
66
 
                                         string_of_int(Char.code c));
67
 
    | Telnet_dont c    -> prerr_endline ("Telnet: DONT " ^
68
 
                                         string_of_int(Char.code c));
69
 
    | Telnet_unknown c -> prerr_endline ("Telnet: unknown command " ^
70
 
                                         string_of_int(Char.code c));
71
 
    | Telnet_eof       -> prerr_endline "Telnet: <eof>";
72
 
    | Telnet_timeout   -> prerr_endline "Telnet: <timeout>";
 
71
      Telnet_data s    -> dlog ("command: Data " ^ s)
 
72
    | Telnet_nop       -> dlog "command: NOP";
 
73
    | Telnet_dm        -> dlog "command: DM";
 
74
    | Telnet_brk       -> dlog "command: BRK";
 
75
    | Telnet_ip        -> dlog "command: IP";
 
76
    | Telnet_ao        -> dlog "command: AO";
 
77
    | Telnet_ayt       -> dlog "command: AYT";
 
78
    | Telnet_ec        -> dlog "command: EC";
 
79
    | Telnet_el        -> dlog "command: EL";
 
80
    | Telnet_ga        -> dlog "command: GA";
 
81
    | Telnet_sb c      -> dlog ("command: DB " ^ 
 
82
                                  string_of_int(Char.code c));
 
83
    | Telnet_se        -> dlog "command: SE";
 
84
    | Telnet_will c    -> dlog ("command: WILL " ^
 
85
                                  string_of_int(Char.code c));
 
86
    | Telnet_wont c    -> dlog ("command: WONT " ^
 
87
                                  string_of_int(Char.code c));
 
88
    | Telnet_do c      -> dlog ("command: DO " ^
 
89
                                  string_of_int(Char.code c));
 
90
    | Telnet_dont c    -> dlog ("command: DONT " ^
 
91
                                  string_of_int(Char.code c));
 
92
    | Telnet_unknown c -> dlog ("command: unknown command " ^
 
93
                                  string_of_int(Char.code c));
 
94
    | Telnet_eof       -> dlog "command: <eof>";
 
95
    | Telnet_timeout   -> dlog "command: <timeout>";
73
96
;;
74
97
 
75
98
 
82
105
 
83
106
type telnet_options =
84
107
    { connection_timeout : float;
85
 
      verbose_connection : bool;
86
108
      verbose_input : bool;
87
109
      verbose_output : bool;
88
110
    }
203
225
    val mutable group = None
204
226
    val mutable socket = Unix.stdin
205
227
    val mutable socket_state = Down
206
 
    val mutable connecting = false
 
228
    val mutable connecting = None
207
229
    val mutable polling_wr = false
208
230
    val mutable input_timed_out = false
209
231
    val mutable output_timed_out = false
210
232
 
211
233
    val mutable options = 
212
234
            { connection_timeout = 300.0;
213
 
              verbose_connection = false;
214
235
              verbose_input = false;
215
236
              verbose_output = false;
216
237
            }
470
491
        g1
471
492
        0.0
472
493
        (fun () -> 
473
 
           try
474
 
             self # connect_server;
475
 
             (* 'group' must not be set earlier, because it is used as
476
 
              * indicator whether a connection is established or not.
477
 
              *)
478
 
             group <- Some g;
479
 
             let timeout_value = options.connection_timeout in
480
 
             Unixqueue.add_resource esys g (Unixqueue.Wait_in socket, 
481
 
                                            timeout_value);
482
 
             Unixqueue.add_close_action esys g (socket, 
483
 
                                                (fun _ -> self # shutdown));
484
 
             Unixqueue.add_handler esys g (self # handler);
485
 
             polling_wr <- false;
486
 
             self # maintain_polling;
487
 
           with
488
 
               Unix.Unix_error(_,_,_) as x -> exn_handler x
489
 
             | Sys_error _ as x -> exn_handler x
 
494
           self # connect_server
 
495
             (fun () ->
 
496
                dlog "Telnet connection: Connected!";
 
497
                (* 'group' must not be set earlier, because it is used as
 
498
                 * indicator whether a connection is established or not.
 
499
                 *)
 
500
                group <- Some g;
 
501
                let timeout_value = options.connection_timeout in
 
502
                Unixqueue.add_resource esys g (Unixqueue.Wait_in socket, 
 
503
                                               timeout_value);
 
504
                Unixqueue.add_handler esys g (self # handler);
 
505
                polling_wr <- false;
 
506
                self # maintain_polling
 
507
             )
 
508
             (fun err ->
 
509
                dlog "Telnet connection: Connection error!";
 
510
                exn_handler err
 
511
             )
490
512
        )
491
513
 
492
514
 
508
530
      self # update()
509
531
 
510
532
 
511
 
    method private inet_addr hostname =
512
 
      try
513
 
        (* TODO: 'inet_addr_of_string' may block *)
514
 
        syscall (fun () -> Unix.inet_addr_of_string hostname)
515
 
      with
516
 
          Failure _ ->
517
 
            try
518
 
              let h = syscall (fun () -> Unix.gethostbyname hostname) in
519
 
              h.Unix.h_addr_list.(0)
520
 
            with Not_found ->
521
 
              raise 
522
 
                (Sys_error 
523
 
                   ("Telnet_client: host name lookup failed for " ^ hostname));
524
 
 
525
 
 
526
 
    method private connect_server =
 
533
    method expect_input flag =
 
534
      match group with
 
535
        | None ->
 
536
            failwith "Telnet_client: not attached"
 
537
        | Some g ->
 
538
            Unixqueue.remove_resource esys g (Unixqueue.Wait_in socket);
 
539
            let timeout_value =
 
540
              if flag then 
 
541
                options.connection_timeout
 
542
              else
 
543
                (-1.0) in
 
544
            Unixqueue.add_resource esys g (Unixqueue.Wait_in socket, 
 
545
                                           timeout_value)
 
546
            
 
547
 
 
548
    method private connect_server f_ok f_err =
527
549
 
528
550
      begin match connector with
529
 
          Telnet_connect(hostname, port) ->
530
 
            if options.verbose_connection then
531
 
              prerr_endline ("Telnet connection: Connecting to server " ^ 
532
 
                             hostname);
533
 
 
534
 
            let addr = self # inet_addr hostname in
535
 
 
536
 
            let dom = Netsys.domain_of_inet_addr addr in
537
 
            let s = syscall 
538
 
                      (fun () -> Unix.socket dom Unix.SOCK_STREAM 0) in
539
 
            (* Connect in non-blocking mode: *)
540
 
            syscall (fun () -> Unix.set_nonblock s);
541
 
            (* Urgent data is received inline: *)
542
 
            syscall (fun () -> Unix.setsockopt s Unix.SO_OOBINLINE true);
543
 
            begin try
544
 
              syscall (fun () -> Unix.connect s (Unix.ADDR_INET (addr, port)));
545
 
              connecting <- false;
546
 
              if options.verbose_connection then
547
 
                prerr_endline "Telnet connection: Connected!";
548
 
            with
549
 
                Unix.Unix_error(Unix.EINPROGRESS,_,_) ->
550
 
                  (* The 'connect' has not yet been finished. *)
551
 
                  connecting <- true;
552
 
                  (* The 'connect' operation continues in the background.
553
 
                   * It is guaranteed that the socket becomes writeable if
554
 
                   * the connection is established.
555
 
                   * (Of course, it becomes readable if there is already data
556
 
                   * to read, but if the other side does not send us anything
557
 
                   * only writeability is indicated.)
558
 
                   * If the connection fails: This situation is not very well
559
 
                   * described in the manual pages. The "Single Unix Spec"
560
 
                   * says nothing about this case. In the Linux manpages I 
561
 
                   * found that it is possible to read the O_ERROR socket option
562
 
                   * (see connect(2)). By experience I found out that the socket
563
 
                   * indicates readability, and that the following "read" 
564
 
                   * syscall then reports the error correctly.
565
 
                   * The O_ERROR socket option is not supported by O'Caml, so
566
 
                   * the latter is assumed.
567
 
                   *)
568
 
              | any ->
569
 
                  syscall (fun () -> Unix.close s);
570
 
                  raise any;
571
 
            end;
572
 
 
573
 
            socket <- s;
 
551
        | Telnet_connect(hostname, port) ->
 
552
            dlog ("Telnet connection: Connecting to server " ^ 
 
553
                    hostname);
 
554
 
 
555
            let g1 = Unixqueue.new_group esys in
 
556
 
 
557
            let eng =
 
558
              Uq_engines.connector 
 
559
                (`Socket(`Sock_inet_byname(Unix.SOCK_STREAM,
 
560
                                           hostname,
 
561
                                           port),
 
562
                         Uq_engines.default_connect_options))
 
563
                esys in
 
564
            
 
565
            connecting <- Some eng;
 
566
 
 
567
            Uq_engines.when_state
 
568
              ~is_done:(function
 
569
                          | `Socket(s,_) ->
 
570
                              Unixqueue.clear esys g1;
 
571
                              socket <- s;
 
572
                              connecting <- None;
 
573
                              syscall
 
574
                                (fun () -> 
 
575
                                   Unix.setsockopt s Unix.SO_OOBINLINE true);
 
576
                              Netlog.Debug.track_fd
 
577
                                ~owner:"Telnet_client"
 
578
                                ~descr:("connection to " ^ 
 
579
                                          hostname ^  ":" ^ string_of_int port)
 
580
                                s;
 
581
                              f_ok()
 
582
                          | _ -> assert false
 
583
                       )
 
584
              ~is_error:(function
 
585
                           | err ->
 
586
                               Unixqueue.clear esys g1;
 
587
                               connecting <- None;
 
588
                               f_err err
 
589
                        )
 
590
              ~is_aborted:(fun () -> 
 
591
                             Unixqueue.clear esys g1;
 
592
                             connecting <- None
 
593
                          )
 
594
              eng;
 
595
            let timeout_value = options.connection_timeout in
 
596
            Unixqueue.once esys g1 timeout_value eng#abort
574
597
 
575
598
        | Telnet_socket s ->
576
 
            connecting <- false;
 
599
            connecting <- None;
577
600
            syscall(fun () -> Unix.setsockopt s Unix.SO_OOBINLINE true);
578
601
            socket <- s;
579
 
            if options.verbose_connection then
580
 
              prerr_endline "Telnet connection: Got connected socket";
 
602
            Netlog.Debug.track_fd
 
603
              ~owner:"Telnet_client"
 
604
              ~descr:("connection to " ^ 
 
605
                        try Netsys.string_of_sockaddr(Netsys.getpeername s)
 
606
                        with _ -> "(noaddr)")
 
607
              s;
 
608
            dlog "Telnet connection: Got connected socket";
 
609
            let g1 = Unixqueue.new_group esys in
 
610
            Unixqueue.once esys g1 0.0 f_ok
581
611
      end;
582
612
      
583
613
      socket_state <- Up_rw;
591
621
 
592
622
 
593
623
    method private shutdown =
594
 
      if options.verbose_connection then 
595
 
        prerr_endline "Telnet connection: Shutdown!";
 
624
      dlog "Telnet connection: Shutdown!";
596
625
      begin match socket_state with
597
626
          Down -> ()
598
627
        | (Up_rw | Up_r) -> 
599
 
            if options.verbose_connection then 
600
 
              prerr_endline "Telnet connection: Closing socket!";
 
628
            dlog "Telnet connection: Closing socket!";
 
629
            Netlog.Debug.release_fd socket;
601
630
            try
602
631
              syscall (fun () -> Unix.close socket)
603
632
            with
612
641
 
613
642
 
614
643
    method private abort_connection =
615
 
 
616
 
      (* By removing the input and output resources, the event queue is told
617
 
       * that nothing more will be done with the group g, and because of this
618
 
       * the queue invokes the 'close action' (here self # shutdown) and
619
 
       * cleans up the queue.
620
 
       *)
 
644
      ( match connecting with
 
645
          | None -> ()
 
646
          | Some eng -> eng#abort()
 
647
      );
621
648
      match group with
622
649
          Some g -> 
623
650
            Unixqueue.remove_resource esys g (Unixqueue.Wait_in socket);
625
652
              Unixqueue.remove_resource esys g (Unixqueue.Wait_out socket);
626
653
              polling_wr <- false;
627
654
            end;
 
655
            self # shutdown;
628
656
            assert (group = None);
629
657
        | None -> 
630
658
            ()
673
701
      end;
674
702
 
675
703
 
676
 
    method private check_connection =
677
 
      (* You need to call this method only if 'connecting' is true, and of
678
 
       * course if the socket is either readable or writeable.
679
 
       * The socket is set to blocking mode, again. The connect time
680
 
       * is measured and recorded.
681
 
       * TODO: find out if a socket error happened in the meantime.
682
 
       *)
683
 
      if connecting then begin
684
 
        syscall(fun () -> Unix.clear_nonblock socket);
685
 
        connecting <- false;
686
 
        if options.verbose_connection then
687
 
          prerr_endline "Telnet connection: Got connection status";
688
 
      end
689
 
 
690
 
 
691
704
    method private handler  _ _ ev =
692
705
      let g = match group with
693
706
          Some x -> x
696
709
            raise Equeue.Reject
697
710
      in
698
711
      match ev with
699
 
          Unixqueue.Input_arrived (g0,fd0) ->
 
712
        | Unixqueue.Input_arrived (g0,fd0) ->
700
713
            if g0 = g then 
701
714
              try self # handle_input with 
702
715
                  Unix.Unix_error(_,_,_) as x -> exn_handler x
734
747
        
735
748
        Queue.add Telnet_timeout input_queue;
736
749
        
737
 
        if options.verbose_connection then 
738
 
          prerr_endline "Telnet connection: Timeout event!";
 
750
        dlog "Telnet connection: Timeout event!";
739
751
        
740
752
        self # abort_connection;
741
753
        
763
775
 
764
776
      input_timed_out <- false;
765
777
 
766
 
      if options.verbose_connection then 
767
 
        prerr_endline "Telnet connection: Input event!";
 
778
      dlog "Telnet connection: Input event!";
768
779
 
769
780
      let _g = match group with
770
781
          Some x -> x
771
782
        | None -> assert false
772
783
      in
773
784
      
774
 
      if connecting then
775
 
        self # check_connection;
776
 
 
777
785
      (* Read data into the primary_buffer *)
778
786
 
779
 
      let n =
 
787
      let n, eof =
780
788
        syscall
781
789
          (fun () ->
782
 
             Unix.read socket primary_buffer 0 (String.length primary_buffer)) in
783
 
      let eof = (n=0) in
 
790
             try
 
791
               let n =
 
792
                 Unix.read 
 
793
                   socket primary_buffer 0 (String.length primary_buffer) in
 
794
               (n, n=0)
 
795
             with
 
796
               | Unix.Unix_error(Unix.EAGAIN,_,_) -> 
 
797
                   (0, false)
 
798
          ) in
784
799
 
785
800
      Netbuffer.add_sub_string input_buffer primary_buffer 0 n;
786
801
 
902
917
      in
903
918
 
904
919
      if eof then begin
905
 
        if options.verbose_connection then
906
 
          prerr_endline "Telnet connection: Got EOF";
 
920
        dlog "got EOF";
907
921
        Queue.add Telnet_eof input_queue;
908
922
        self # abort_connection;
909
923
      end
910
924
      else
911
925
        interpret 0;
912
926
 
913
 
      if options.verbose_input then begin
914
 
        prerr_endline "Telnet input queue:";
 
927
      if !Debug.enable && options.verbose_input then begin
 
928
        dlog "Telnet input queue:";
915
929
        Queue.iter prerr_command input_queue;
916
 
        prerr_endline "Telnet: <end of queue>";
 
930
        dlog "<end of queue>";
917
931
      end;
918
932
 
919
933
 
945
959
 
946
960
      output_timed_out <- false;
947
961
 
948
 
      if options.verbose_connection then 
949
 
        prerr_endline "Telnet connection: Output event!";
 
962
      dlog "Telnet connection: Output event!";
950
963
 
951
964
      let _g = match group with
952
965
          Some x -> x
953
966
        | None -> assert false
954
967
      in
955
968
 
956
 
      if connecting then
957
 
        self # check_connection;
958
 
 
959
969
      (* If the write buffer is empty, copy new commands from the write
960
970
       * queue to the write buffer.
961
971
       *)
1052
1062
 
1053
1063
        if q == synch_queue then begin
1054
1064
          sending_urgent_data <- true;
1055
 
          if options.verbose_connection then
1056
 
            prerr_endline "Sending urgent data";
 
1065
          dlog "Sending urgent data";
1057
1066
        end
1058
1067
        else
1059
1068
          sending_urgent_data <- false;
1060
1069
 
1061
 
        if options.verbose_output then begin
1062
 
          prerr_endline "Telnet output queue:";
 
1070
        if !Debug.enable && options.verbose_output then begin
 
1071
          dlog "Telnet output queue:";
1063
1072
          Queue.iter prerr_command output_queue;
1064
 
          prerr_endline "Telnet: <end of queue>";
 
1073
          dlog "<end of queue>";
1065
1074
        end;
1066
1075
 
1067
1076
        try copy() with Queue.Empty -> ()
1074
1083
        let k = 
1075
1084
          syscall
1076
1085
            (fun () ->
1077
 
               Unix.send socket (Netbuffer.unsafe_buffer output_buffer) 0 l flags) in
 
1086
               try
 
1087
                 Unix.send
 
1088
                   socket (Netbuffer.unsafe_buffer output_buffer) 0 l flags
 
1089
               with
 
1090
                 | Unix.Unix_error(Unix.EAGAIN,_,_) -> 0
 
1091
            ) in
1078
1092
        Netbuffer.delete output_buffer 0 k;
1079
1093
      end;
1080
1094
 
1081
 
      if Netbuffer.length output_buffer = 0 & send_eof then begin
1082
 
        if options.verbose_connection then
1083
 
          prerr_endline "Telnet connection: Sending EOF";
 
1095
      if Netbuffer.length output_buffer = 0 && send_eof then begin
 
1096
        dlog "Telnet connection: Sending EOF";
1084
1097
        syscall(fun () -> Unix.shutdown socket Unix.SHUTDOWN_SEND);
1085
1098
        socket_state <- Up_r;
1086
1099
      end;
1089
1102
  end
1090
1103
;;
1091
1104
 
1092
 
 
 
1105
let () =
 
1106
  Netsys_signal.init()