~ubuntu-branches/ubuntu/maverick/ocaml-cry/maverick

« back to all changes in this revision

Viewing changes to src/cry.ml

• browse files at revision 4
• compare with another revision
• download diff
• download tarball
• view history from revision 4

Show diffs side-by-side

added

removed

src/cry.ml

308

308

let http_header =

309

309

  Printf.sprintf "SOURCE %s HTTP/1.1\r\n%s\r\n\r\n"

310

310

 

311

 

let get_auth source = 

312

 

  Printf.sprintf "Basic %s" (encode64 (source.user ^ ":" ^ source.password))

 

311

let get_auth user password = 

 

312

  Printf.sprintf "Basic %s" (encode64 (user ^ ":" ^ password))

313

313

 

314

314

let write_data socket request =

315

315

  let len = String.length request in

386

386

    | _ -> raise (Error (Bad_answer None))

387

387

 

388

388

let connect_http c socket source = 

389

 

  let auth = get_auth source in 

 

389

  let auth = get_auth source.user source.password in 

390

390

  try

391

391

    Hashtbl.add source.headers "Authorization" auth;

392

392

    let headers = header_string source in

500

500

  Printf.sprintf 

501

501

    "GET /admin.cgi?mode=updinfo&pass=%s%s HTTP/1.0\r\n%s\r\n"

502

502

 

503

 

let update_metadata c m = 

504

 

  let source = 

505

 

    match c.status with

506

 

      | PrivConnected (x,_) -> x 

507

 

      | _ -> raise (Error Not_connected)

 

503

let manual_update_metadata 

 

504

       ~host ~port ~protocol ~user ~password 

 

505

       ~mount ?headers ?(ipv6=false) 

 

506

       ?bind m =

 

507

  let mount = 

 

508

    if mount.[0] <> '/' then

 

509

      "/" ^ mount

 

510

    else

 

511

      mount

 

512

  in 

 

513

  let headers = 

 

514

    match headers with

 

515

      | Some x -> x

 

516

      | None   -> Hashtbl.create 0

508

517

  in

509

 

  if not c.icy_cap then

510

 

    raise (Error Invalid_usage);

511

 

  let socket = create_socket ~ipv6:c.ipv6 ?bind:c.bind () in

 

518

  let socket = create_socket ~ipv6 ?bind () in

512

519

  let close () = 

513

520

   try

514

521

    Unix.close socket

516

523

     | _ -> raise (Error Close)

517

524

  in

518

525

  try

519

 

    connect_socket socket source.host source.port ;

 

526

    connect_socket socket host port ;

520

527

    let user_agent =

521

528

      try

522

 

        Hashtbl.find source.headers "User-Agent"

 

529

        Hashtbl.find headers "User-Agent"

523

530

      with

524

531

        | Not_found -> "ocaml-cry"

525

532

    in

526

533

    (** This seems to be needed for shoutcast *)

527

534

    let agent_complement = 

528

 

      if source.protocol = Icy then

 

535

      if protocol = Icy then

529

536

        " (Mozilla compatible)"

530

537

      else

531

538

        ""

543

550

      Hashtbl.fold f m ""

544

551

    in

545

552

    let request = 

546

 

      match source.protocol with

 

553

      match protocol with

547

554

        | Http ->

548

555

            let headers = 

549

 

              Printf.sprintf "Authorization: %s\r\n%s" (get_auth source) user_agent

 

556

              Printf.sprintf "Authorization: %s\r\n%s" (get_auth user password) user_agent

550

557

            in

551

 

            http_meta_request source.mount meta headers

552

 

        | Icy -> icy_meta_request source.password meta user_agent

 

558

            http_meta_request mount meta headers

 

559

        | Icy -> icy_meta_request password meta user_agent

553

560

    in

554

561

    write_data socket request;

555

562

    (** Read input from socket. *)

568

575

       end ;

569

576

       raise e

570

577

 

 

578

let update_metadata c m = 

 

579

  let source =                                                              

 

580

    match c.status with                                                     

 

581

      | PrivConnected (x,_) -> x                                            

 

582

      | _ -> raise (Error Not_connected) 

 

583

  in

 

584

  if not c.icy_cap then                                                     

 

585

    raise (Error Invalid_usage);

 

586

  let user = source.user in

 

587

  let port = source.port in

 

588

  let password = source.password in

 

589

  let headers = Some source.headers in

 

590

  let protocol = source.protocol in

 

591

  let mount = source.mount in

 

592

  let host = source.host in

 

593

  let ipv6 = c.ipv6 in

 

594

  let bind = c.bind in

 

595

  manual_update_metadata 

 

596

       ~host ~port ~protocol 

 

597

       ~user ~password

 

598

       ~mount ?headers 

 

599

       ~ipv6 ?bind m

 

600

 

571

601

let send c x =

572

602

  try

573

 

    let socket = get_socket c in 

574

 

    let out_e = Unix.out_channel_of_descr socket in

575

 

    output_string out_e x;

576

 

    flush out_e

 

603

    let socket = get_socket c in

 

604

    let len = String.length x in

 

605

    let rec write ofs = 

 

606

      let rem = len - ofs in

 

607

      let ret = Unix.write socket x ofs rem in

 

608

      if ret < rem then

 

609

        write (ofs+ret)

 

610

    in

 

611

    write 0 

577

612

  with

578

613

    | _ -> raise (Error Write)

579

614

 

• Older »

Loggerhead is a web-based interface for Breezy
Version: 2.0.1