Patch subject is complete summary.
ocaml/OMakefile | 1 - ocaml/in_guest_install/OMakefile | 6 +- ocaml/netdev/OMakefile | 5 - ocaml/netdev/addr_stubs.c | 116 ----------- ocaml/netdev/bridge_stubs.c | 85 -------- ocaml/netdev/link_stubs.c | 179 ----------------- ocaml/netdev/netdev.h | 33 --- ocaml/netdev/netdev.ml | 412 ----------------------------------------- ocaml/netdev/netdev.mli | 138 ------------- ocaml/netdev/sockios_compat.h | 6 - ocaml/xapi/OMakefile | 6 +- ocaml/xe-cli/OMakefile | 5 +- ocaml/xe-cli/rt/OMakefile | 6 +- ocaml/xenops-ts/OMakefile | 6 +- ocaml/xenops/OMakefile | 8 +- ocaml/xiu/OMakefile | 6 +- 16 files changed, 21 insertions(+), 997 deletions(-)
# HG changeset patch # User Jonathan Ludlam <[email protected]> # Date 1275485468 -3600 # Node ID b06f07f4cd089928ee177f3b800ba454fa6d2771 # Parent d3c124fa2c15930d287cb67f6b34547d90923043 [mq]: netdev-library diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/OMakefile --- a/ocaml/OMakefile +++ b/ocaml/OMakefile @@ -22,7 +22,6 @@ xva \ guest \ console \ - netdev \ auth \ events \ in_guest_install \ diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/in_guest_install/OMakefile --- a/ocaml/in_guest_install/OMakefile +++ b/ocaml/in_guest_install/OMakefile @@ -1,6 +1,6 @@ -OCAML_LIBS = ../idl/ocaml_backend/common ../idl/ocaml_backend/client ../netdev/netdev ../xenops/xenops -OCAMLINCLUDES = ../idl/ocaml_backend ../autogen ../idl ../netdev ../xenops -OCAMLPACKS = unix stdext xml-light2 +OCAML_LIBS = ../idl/ocaml_backend/common ../idl/ocaml_backend/client ../xenops/xenops +OCAMLINCLUDES = ../idl/ocaml_backend ../autogen ../idl ../xenops +OCAMLPACKS = unix stdext xml-light2 netdev OCAMLFLAGS += -dtypes -warn-error F -cclib -static diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/netdev/OMakefile --- a/ocaml/netdev/OMakefile +++ /dev/null @@ -1,5 +0,0 @@ -OCamlLibraryClib(netdev, netdev, netdev_stubs) -StaticCLibrary(netdev_stubs, bridge_stubs link_stubs addr_stubs) -OCamlDocLibrary(netdev, netdev) - -OCAML_LIBS += netdev diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/netdev/addr_stubs.c --- a/ocaml/netdev/addr_stubs.c +++ /dev/null @@ -1,116 +0,0 @@ -/* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program 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 - * GNU Lesser General Public License for more details. - */ -/* - */ - -#include <ifaddrs.h> -#include <netinet/in.h> -#include <string.h> -#include <stdio.h> - -#include <caml/mlvalues.h> -#include <caml/memory.h> -#include <caml/alloc.h> -#include <caml/custom.h> -#include <caml/fail.h> -#include <caml/signals.h> - -static value alloc_addr(struct sockaddr *sock) -{ - CAMLparam0(); - CAMLlocal1(result); - char output[36]; - int ret = 0; - - switch (sock->sa_family) { - case AF_INET: { - struct sockaddr_in *in = (struct sockaddr_in *) sock; - int v = ntohl(in->sin_addr.s_addr); - ret = snprintf(output, sizeof(output), "%u.%u.%u.%u", - (v >> 24) & 0xff, (v >> 16) & 0xff, - (v >> 8) & 0xff, v & 0xff); - break; - } - case AF_INET6: { - struct sockaddr_in6 *in6 = (struct sockaddr_in6 *) sock; - ret = snprintf(output, sizeof(output), - "%02x%02x:%02x%02x:%02x%02x:%02x%02x:%02x%02x:%02x%02x:%02x%02x", - in6->sin6_addr.s6_addr[0], - in6->sin6_addr.s6_addr[1], - in6->sin6_addr.s6_addr[2], - in6->sin6_addr.s6_addr[3], - in6->sin6_addr.s6_addr[4], - in6->sin6_addr.s6_addr[5], - in6->sin6_addr.s6_addr[6], - in6->sin6_addr.s6_addr[7], - in6->sin6_addr.s6_addr[8], - in6->sin6_addr.s6_addr[9], - in6->sin6_addr.s6_addr[10], - in6->sin6_addr.s6_addr[11], - in6->sin6_addr.s6_addr[12], - in6->sin6_addr.s6_addr[13]); - break; - } - default: - /* just ignore */ - ; - } - result = caml_alloc_string(ret); - memcpy(String_val(result), output, ret); - CAMLreturn(result); -} - -value stub_if_getaddr(value unit) -{ - CAMLparam0(); - CAMLlocal5(result, temp, name, addrstr, netmaskstr); - CAMLlocal1(tuple); - int ret; - struct ifaddrs *ifaddrs, *tmp; - struct sockaddr *sock, *netmask; - - result = temp = Val_emptylist; - name = addrstr = Val_int(0); - - ret = getifaddrs(&ifaddrs); - if (ret < 0) - caml_failwith("cannot get interface address"); - - for (tmp = ifaddrs; tmp; tmp = tmp->ifa_next) { - sock = tmp->ifa_addr; - netmask = tmp->ifa_netmask; - - if (sock->sa_family == AF_INET || sock->sa_family == AF_INET6) { - name = caml_copy_string(tmp->ifa_name); - addrstr = alloc_addr(sock); - netmaskstr = alloc_addr(netmask); - - tuple = caml_alloc_tuple(4); - Store_field(tuple, 0, name); - Store_field(tuple, 1, addrstr); - Store_field(tuple, 2, netmaskstr); - Store_field(tuple, 3, Val_bool(sock->sa_family == AF_INET6)); - - result = caml_alloc_small(2, Tag_cons); - Field(result, 0) = tuple; - Field(result, 1) = temp; - - temp = result; - } - } - - freeifaddrs(ifaddrs); - - CAMLreturn(result); -} diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/netdev/bridge_stubs.c --- a/ocaml/netdev/bridge_stubs.c +++ /dev/null @@ -1,85 +0,0 @@ -/* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program 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 - * GNU Lesser General Public License for more details. - */ -/* - */ - -#include "netdev.h" - -#include <caml/mlvalues.h> -#include <caml/memory.h> -#include <caml/alloc.h> -#include <caml/custom.h> -#include <caml/fail.h> -#include <caml/signals.h> - -value stub_bridge_add(value fd, value name) -{ - CAMLparam2(fd, name); - int err; - - err = ioctl(Int_val(fd), SIOCBRADDBR, String_val(name)); - CHECK_IOCTL(err, "bridge add"); - CAMLreturn(Val_unit); -} - -value stub_bridge_del(value fd, value name) -{ - CAMLparam2(fd, name); - int err; - - err = ioctl(Int_val(fd), SIOCBRDELBR, String_val(name)); - CHECK_IOCTL(err, "bridge del"); - CAMLreturn(Val_unit); -} - -value stub_bridge_intf_add(value fd, value name, value intf) -{ - CAMLparam3(fd, name, intf); - int err; - struct ifreq ifr; - int ifindex; - - ifindex = if_nametoindex(String_val(intf)); - if (ifindex == 0) - caml_failwith("Device_not_found"); - - memset(ifr.ifr_name, '\000', IFNAMSIZ); - strncpy(ifr.ifr_name, String_val(name), IFNAMSIZ); - ifr.ifr_ifindex = ifindex; - - err = ioctl(Int_val(fd), SIOCBRADDIF, &ifr); - CHECK_IOCTL(err, "bridge intf add"); - CAMLreturn(Val_unit); -} - -value stub_bridge_intf_del(value fd, value name, value intf) -{ - CAMLparam3(fd, name, intf); - int err; - struct ifreq ifr; - int ifindex; - - ifindex = if_nametoindex(String_val(intf)); - if (ifindex == 0) - caml_failwith("Device_not_found"); - - memset(ifr.ifr_name, '\000', IFNAMSIZ); - strncpy(ifr.ifr_name, String_val(name), IFNAMSIZ); - ifr.ifr_ifindex = ifindex; - - err = ioctl(Int_val(fd), SIOCBRDELIF, &ifr); - CHECK_IOCTL(err, "bridge intf del"); - - CAMLreturn(Val_unit); -} diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/netdev/link_stubs.c --- a/ocaml/netdev/link_stubs.c +++ /dev/null @@ -1,179 +0,0 @@ -/* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program 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 - * GNU Lesser General Public License for more details. - */ -/* - */ - -#include "netdev.h" - -#include <caml/mlvalues.h> -#include <caml/memory.h> -#include <caml/alloc.h> -#include <caml/custom.h> -#include <caml/fail.h> -#include <caml/signals.h> - -#define SET_IFREQ(ifreq, devname) \ - strncpy(ifreq.ifr_name, devname, IFNAMSIZ) - -static int link_change_flags(int fd, char *name, - unsigned int flags, unsigned int mask) -{ - struct ifreq ifr; - int ret; - - SET_IFREQ(ifr, name); - ret = ioctl(fd, SIOCGIFFLAGS, &ifr); - if (ret < 0) - return ret; - if ((ifr.ifr_flags ^ flags) & mask) { - ifr.ifr_flags &= ~mask; - ifr.ifr_flags |= mask & flags; - ret = ioctl(fd, SIOCSIFFLAGS, &ifr); - } - return ret; -} - -static int link_change_name(int fd, char *name, char *newname) -{ - struct ifreq ifr; - int ret; - - SET_IFREQ(ifr, name); - strncpy(ifr.ifr_newname, newname, IFNAMSIZ); - ret = ioctl(fd, SIOCSIFNAME, &ifr); - return ret; -} - -value stub_link_up(value fd, value dev) -{ - CAMLparam2(fd, dev); - int err; - err = link_change_flags(Int_val(fd), String_val(dev), IFF_UP, IFF_UP); - CHECK_IOCTL(err, "link up"); - CAMLreturn(Val_unit); -} - -value stub_link_is_up(value fd, value dev) -{ - CAMLparam2(fd, dev); - struct ifreq ifr; - int err; - - SET_IFREQ(ifr, String_val(dev)); - err = ioctl(Int_val(fd), SIOCGIFFLAGS, &ifr); - CHECK_IOCTL(err, "link_is_up"); - CAMLreturn(Val_bool (ifr.ifr_flags & IFF_UP)); -} - -value stub_link_down(value fd, value dev) -{ - CAMLparam2(fd, dev); - int err; - err = link_change_flags(Int_val(fd), String_val(dev), 0, IFF_UP); - CHECK_IOCTL(err, "link down"); - - CAMLreturn(Val_unit); -} - -value stub_link_change_name(value fd, value dev, value newname) -{ - CAMLparam3(fd, dev, newname); - int err; - - err = link_change_name(Int_val(fd), - String_val(dev), String_val(newname)); - CHECK_IOCTL(err, "link change name"); - CAMLreturn(Val_unit); -} - -value stub_link_multicast(value fd, value dev, value v) -{ - CAMLparam3(fd, dev, v); - int err; - err = link_change_flags(Int_val(fd), String_val(dev), - ((Bool_val(v)) ? IFF_MULTICAST : 0), IFF_MULTICAST); - CHECK_IOCTL(err, "link multicast"); - CAMLreturn(Val_unit); -} - -value stub_link_arp(value fd, value dev, value v) -{ - CAMLparam3(fd, dev, v); - int err; - err = link_change_flags(Int_val(fd), String_val(dev), - ((Bool_val(v)) ? 0 : IFF_NOARP), IFF_NOARP); - CHECK_IOCTL(err, "link arp"); - CAMLreturn(Val_unit); -} - -#ifdef SIOCETHTOOL -#define ETHTOOL_GSET 0x00000001 /* Get settings. */ - -#include <stdint.h> -/* copied from linux/ethtool.h and made compilable with userspace types */ -struct ethtool_cmd { - uint32_t cmd; - uint32_t supported; /* Features this interface supports */ - uint32_t advertising; /* Features this interface advertises */ - uint16_t speed; /* The forced speed, 10Mb, 100Mb, gigabit */ - uint8_t duplex; /* Duplex, half or full */ - uint8_t port; /* Which connector port */ - uint8_t phy_address; - uint8_t transceiver; /* Which transceiver to use */ - uint8_t autoneg; /* Enable or disable autonegotiation */ - uint32_t maxtxpkt; /* Tx pkts before generating tx int */ - uint32_t maxrxpkt; /* Rx pkts before generating rx int */ - uint32_t reserved[4]; -}; - -value stub_link_get_status(value fd, value dev) -{ - CAMLparam2(fd, dev); - CAMLlocal1(ret); - struct ifreq ifr; - struct ethtool_cmd ecmd; - int err, speed, duplex; - - SET_IFREQ(ifr, String_val(dev)); - ecmd.cmd = ETHTOOL_GSET; - ifr.ifr_data = (caddr_t) &ecmd; - err = ioctl(Int_val(fd), SIOCETHTOOL, &ifr); - CHECK_IOCTL(err, "get ethtool"); - - /* CA-24610: apparently speeds can be other values eg 2500 */ - speed = ecmd.speed; - - switch (ecmd.duplex) { - case 0: duplex = 1; break; - case 1: duplex = 2; break; - default: duplex = 0; - } - - ret = caml_alloc_tuple(2); - Store_field(ret, 0, Val_int(speed)); - Store_field(ret, 1, Val_int(duplex)); - - CAMLreturn(ret); -} -#else -value stub_link_get_status(value fd, value dev) -{ - CAMLparam2(fd, dev); - CAMLlocal1(ret); - ret = caml_alloc_tuple(2); - Store_field(ret, 0, Val_int(0)); /* unknown speed */ - Store_field(ret, 1, Val_int(0)); /* unknown duplex */ - CAMLreturn(ret); -} -#endif diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/netdev/netdev.h --- a/ocaml/netdev/netdev.h +++ /dev/null @@ -1,33 +0,0 @@ -/* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program 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 - * GNU Lesser General Public License for more details. - */ -/* - */ - -#include <string.h> -#include <stdio.h> -#include <unistd.h> -#include <sys/ioctl.h> -#include <sys/types.h> -#include <sys/socket.h> -#include <net/if.h> -#include <linux/sockios.h> - -#ifndef SIOCBRADDBR -#include "sockios_compat.h" -#endif - -#define CHECK_IOCTL(err, S) \ - if (err < 0) { \ - caml_failwith(S ": ioctl failed"); \ - } diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/netdev/netdev.ml --- a/ocaml/netdev/netdev.ml +++ /dev/null @@ -1,412 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program 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 - * GNU Lesser General Public License for more details. - *) -open Stringext -open Forkhelpers - -type kind = Bridge | Vswitch - -type network_ops = { - kind: kind; - add: string -> ?uuid:string -> unit; - del: string -> unit; - list: unit -> string list; - - exists: string -> bool; - - intf_add: string -> string -> unit; - intf_del: string -> string -> unit; - intf_list: string -> string list; - - get_bridge: string -> string; - is_on_bridge: string -> bool; - - set_forward_delay: string -> int -> unit; -} - -exception Unknown_network_backend of string -exception Invalid_network_backend_operation of string * kind - -let string_of_kind kind = match kind with - | Bridge -> "bridge" - | Vswitch -> "openvswitch" - -let kind_of_string s = match s with - | "bridge" -> Bridge - | "vswitch" -> Vswitch - | "openvswitch" -> Vswitch - | _ -> raise (Unknown_network_backend s) - -module Internal = struct - -let control_socket () = - try - Unix.socket Unix.PF_INET Unix.SOCK_DGRAM 0 - with - exn -> - try - Unix.socket Unix.PF_UNIX Unix.SOCK_DGRAM 0 - with - exn -> - Unix.socket Unix.PF_INET6 Unix.SOCK_DGRAM 0 - -let with_fd f = - let fd = control_socket () in - let r = begin try - f fd - with - exn -> - Unix.close fd; - raise exn - end in - Unix.close fd; - r - -let exec cmd = - let ret = Sys.command cmd in - if ret <> 0 then - failwith (Printf.sprintf "cmd returned %d" ret) - -let read_one_line file = - let inchan = open_in file in - try - let result = input_line inchan in - close_in inchan; - result - with exn -> close_in inchan; raise exn - -let write_one_line file l = - let outchan = open_out file in - try - output_string outchan (l ^ "\n"); - close_out outchan - with - exn -> close_out outchan; raise exn -end - -module Bridge = struct - -external _add : Unix.file_descr -> string -> unit = "stub_bridge_add" -external _del : Unix.file_descr -> string -> unit = "stub_bridge_del" - -let add name ?uuid = - Internal.with_fd (fun fd -> _add fd name) - -let del name = - Internal.with_fd (fun fd -> _del fd name) - -let list () = - let dirs = Array.to_list (Sys.readdir "/sys/class/net") in - List.filter (fun dir -> - Sys.file_exists ("/sys/class/net/" ^ dir ^ "/bridge")) dirs - -let exists name = - try Sys.file_exists ("/sys/class/net/" ^ name ^ "/bridge") - with _ -> false - -let set name obj v = - let file = "/sys/class/net/" ^ name ^ "/bridge/" ^ obj in - let outchan = open_out file in - output_string outchan v; - output_char outchan '\n'; - close_out outchan - -let get name obj = Internal.read_one_line ("/sys/class/net/" ^ name ^ "/bridge/" ^ obj) - -let _forward_delay = "forward_delay" -let _hello_time = "hello_time" -let _max_age = "max_age" -let _ageing_time = "ageing_time" -let _stp_state = "stp_state" -let _priority = "priority" -let _bridge_id = "bridge_id" - -let get_id name = - get name _bridge_id - -let set_forward_delay name v = - set name _forward_delay (string_of_int v) - -let get_forward_delay name = - int_of_string (get name _forward_delay) - -let set_hello_time name v = - set name _hello_time (string_of_int v) - -let get_hello_time name = - int_of_string (get name _hello_time) - -let set_max_age name v = - set name _max_age (string_of_int v) - -let get_max_age name = - int_of_string (get name _max_age) - -let set_ageing_time name v = - set name _ageing_time (string_of_int v) - -let get_ageing_time name = - int_of_string (get name _ageing_time) - -let set_stp_state name v = - set name _stp_state (if v then "1" else "0") - -let get_stp_state name = - get name _stp_state <> "0" - -let set_priority name v = - set name _priority (string_of_int v) - -let get_priority name = - int_of_string (get name _priority) - -(* bridge interfaces control function *) -external _intf_add : Unix.file_descr -> string -> string -> unit - = "stub_bridge_intf_add" -external _intf_del : Unix.file_descr -> string -> string -> unit - = "stub_bridge_intf_del" - -let intf_add name intf = - Internal.with_fd (fun fd -> _intf_add fd name intf) - -let intf_del name intf = - Internal.with_fd (fun fd -> _intf_del fd name intf) - -let intf_list name = - Array.to_list (Sys.readdir ("/sys/class/net/" ^ name ^ "/brif/")) - -let getpath dev attr = Printf.sprintf "/sys/class/net/%s/%s" dev attr - -let is_on_bridge name = try Unix.access (getpath name "brport") [ Unix.F_OK ]; true with _ -> false - -let get_bridge name = Filename.basename (Unix.readlink ((getpath name "brport") ^ "/bridge")) - -let ops = { - kind = Bridge; - - add = add; - del = del; - list = list; - - exists = exists; - - intf_add = intf_add; - intf_del = intf_del; - intf_list = intf_list; - - get_bridge = get_bridge; - is_on_bridge = is_on_bridge; - - set_forward_delay = set_forward_delay; -} - -end - -module Vswitch = struct - -let vsctl_script = "/usr/bin/ovs-vsctl" - -let vsctl args = - Unix.access vsctl_script [ Unix.X_OK ]; - let output, _ = Forkhelpers.execute_command_get_output vsctl_script args in - let stripped = Stringext.String.strip (fun c -> c='\n') output in - match stripped with - | "" -> [] - | s -> Stringext.String.split '\n' s - -let add name ?uuid = - let extra = match uuid with - | Some uuid' -> ["--"; "br-set-external-id"; name; "network-uuids"; uuid'] - | None -> ["--"; "foo"] in - ignore(vsctl (["add-br" ; name] @ extra)) -let del name = ignore(vsctl ["del-br" ; name]) -let list () = vsctl [ "list-br" ] - -let exists name = List.exists (fun x -> x = name) (list ()) - -let intf_add name intf = ignore(vsctl ["add-port"; name; intf]) -let intf_del name intf = ignore(vsctl ["del-port"; name; intf]) -let intf_list name = vsctl [ "list-ports"; name ] - -let get_bridge name = - match vsctl [ "port-to-br"; name ] with - | l::[] -> l - | [] -> failwith ("ovs-vsctl port-to-br: did not return a bridge for port " ^ name) - | _ -> failwith ("ovs-vsctl port-to-br: returned an unexpected number of results for port " ^ name) - -let is_on_bridge name = - match vsctl [ "port-to-br"; name ] with - | l::[] -> true - | [] -> false - | _ -> failwith ("ovs-vsctl port-to-br: returned an unexpected number of results for port " ^ name) - -let ops = { - kind = Vswitch; - - add = add; - del = del; - list = list; - - exists = exists; - - intf_add = intf_add; - intf_del = intf_del; - intf_list = intf_list; - - get_bridge = get_bridge; - is_on_bridge = is_on_bridge; - - set_forward_delay = fun name v -> raise (Invalid_network_backend_operation ("set_forward_delay", Vswitch)) -} - -end - -module Link = struct - -type speed = int (* see CA-24610 *) -type duplex = Duplex_unknown | Duplex_half | Duplex_full - -let string_of_duplex = function - | Duplex_unknown -> "unknown" - | Duplex_half -> "half" - | Duplex_full -> "full" - -let duplex_of_string = function - | "full" -> Duplex_full - | "half" -> Duplex_half - | _ -> Duplex_unknown - -let int_of_speed x = x -let speed_of_int x = x -let speed_unknown = 0 - -external _up : Unix.file_descr -> string -> unit = "stub_link_up" -external _is_up : Unix.file_descr -> string -> bool = "stub_link_is_up" -external _down : Unix.file_descr -> string -> unit = "stub_link_down" -external _multicast : Unix.file_descr -> string -> bool -> unit = "stub_link_multicast" -external _arp : Unix.file_descr -> string -> bool -> unit = "stub_link_arp" -external _change_name : Unix.file_descr -> string -> string -> unit = "stub_link_change_name" -external _get_status : Unix.file_descr -> string -> speed * duplex = "stub_link_get_status" - -let up name = - Internal.with_fd (fun fd -> _up fd name) - -let is_up name = - Internal.with_fd (fun fd -> try _is_up fd name with _ -> false) - -let down name = - Internal.with_fd (fun fd -> _down fd name) - -let multicast name v = - Internal.with_fd (fun fd -> _multicast fd name v) - -let arp name v = - Internal.with_fd (fun fd -> _arp fd name v) - -let change_name name newname = - Internal.with_fd (fun fd -> _change_name fd name newname) - -let set_addr name addr = - (* temporary *) - Internal.exec (Printf.sprintf "ip link set %s addr %s" name addr) - -let get_status name = - Internal.with_fd (fun fd -> _get_status fd name) - -end - -module Addr = struct - -let flush name = - Internal.exec (Printf.sprintf "ip addr flush %s" name) - -external __get_all : unit -> (string * string * string * bool) list = "stub_if_getaddr" - -type addr = IPV4 of string * string | IPV6 of string * string - -let get_all () = - List.map (fun (name, addr, netmask, inet6) -> name, if inet6 then IPV6 (addr,netmask) else IPV4 (addr,netmask)) - (__get_all ()) - -let get_all_ipv4 () = - let ipv4s = List.filter (fun (_, _, _, inet6) -> not inet6) (__get_all ()) in - List.map (fun (name, addr, netmask, _) -> - name, Unix.inet_addr_of_string addr, Unix.inet_addr_of_string netmask - ) ipv4s - -let get name = - List.map (fun (a,b,c) -> (b,c)) (List.filter (fun (dev, _, _) -> dev = name) (get_all_ipv4 ())) - -end - -let list () = - Array.to_list (Sys.readdir "/sys/class/net") - -let getpath dev attr = Printf.sprintf "/sys/class/net/%s/%s" dev attr - -let get_address name = Internal.read_one_line (getpath name "address") - -let get_mtu name = Internal.read_one_line (getpath name "mtu") -let set_mtu name mtu = - Internal.write_one_line (getpath name "mtu") - (string_of_int mtu) - -let get_by_address address = - List.filter - (fun device -> - (* CA-21402: Not everything returned by list() is guaranteed to be a directory containing an address; - so we have to make sure we catch exceptions here so we keep trying the next one and so on.. *) - try String.lowercase (get_address device) = String.lowercase address with _ -> false) - (list ()) - -let get_pcibuspath name = - try - let devpath = Unix.readlink (getpath name "device") in - List.hd (List.rev (String.split '/' devpath)) - with exn -> "N/A" - -let get_carrier name = - let i = int_of_string (Internal.read_one_line (getpath name "carrier")) in - match i with 1 -> true | 0 -> false | _ -> false - -let get_ids name = - let read_id_from path = - try - let l = Internal.read_one_line path in - (* trim 0x *) - String.sub l 2 (String.length l - 2) - with _ -> "" - in - read_id_from (getpath name "device/vendor"), - read_id_from (getpath name "device/device") - -let is_physical name = - try - let link = Unix.readlink (getpath name "device") in - (* filter out device symlinks which look like /../../../devices/xen-backend/vif- *) - not(List.mem "xen-backend" (String.split '/' link)) - with _ -> false - -(* Dispatch network backend operations. *) - -let network_config_file = "/etc/xensource/network.conf" -let network_backend = - try - kind_of_string (String.strip String.isspace (Unixext.read_whole_file_to_string network_config_file)) - with - | Unix.Unix_error(Unix.ENOENT, "open", _) -> Bridge - | Unix.Unix_error(err, op, path) -> failwith (Printf.sprintf "Unix error: %s (%s,%s)\n" (Unix.error_message err) op path) - -let network = match network_backend with - | Bridge -> Bridge.ops - | Vswitch -> Vswitch.ops diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/netdev/netdev.mli --- a/ocaml/netdev/netdev.mli +++ /dev/null @@ -1,138 +0,0 @@ -(* - * Copyright (C) 2009 Citrix Systems Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program 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 - * GNU Lesser General Public License for more details. - *) -(** Interface to the domain 0 network stack. *) - -(** Enumerates possible network backend types. *) -type kind = - Bridge (** Linux Bridge based networking *) - | Vswitch (** Vswitch based networking *) - -(** Possible operations on each network backend type. *) -type network_ops = { - kind : kind; (** The type of network backend. *) - add : string -> ?uuid:string -> unit; (** Add a bridge. *) - del : string -> unit; (** Remove a bridge. *) - list : unit -> string list; (** List all bridges. *) - exists : string -> bool; (** Query the existance of a bridge. *) - intf_add : string -> string -> unit; (** Add a network device as a port on a bridge. *) - intf_del : string -> string -> unit; (** Remove a network device from a bridge. *) - intf_list : string -> string list; (** List all network devices currently attached as a port on a bridge. *) - get_bridge : string -> string; (** Return the bridge to which a network device is currently attached. *) - is_on_bridge : string -> bool; (** Query whether a network device is currently attached to a bridge. *) - set_forward_delay : string -> int -> unit;(** Set the forwarding delay for a device on a bridge. *) -} - -(** Raised when an invalid network backend is detected. *) -exception Unknown_network_backend of string - -(** Raised when an operation in network_ops is not valid for a particular kind *) -exception Invalid_network_backend_operation of string * kind - -(** Returns string name of a network backend type. *) -val string_of_kind : kind -> string - -(** Converts a string to a valid network backend type, or raises Unknown_network_backend. *) -val kind_of_string : string -> kind - -(** Module dealing with network device link characteristics *) -module Link : - sig - (** Link speed in megabits. *) - type speed - - (** Convert speed to a string. *) - val int_of_speed : speed -> int - - (** Create speed from a string. *) - val speed_of_int : int -> speed - - (** Magic speed value representing Unknown. *) - val speed_unknown : speed - - (** Device duplex. *) - type duplex = - Duplex_unknown (** Device duplex is unknown. *) - | Duplex_half (** Device is running half-duplex. *) - | Duplex_full (** Device is running full-duplex. *) - - (** Convert duplex setting to string. *) - val string_of_duplex : duplex -> string - - (** Create duplex from a string *) - val duplex_of_string : string -> duplex - - (** Bring up a network device. *) - val up : string -> unit - - (** Determine if a network device is up. *) - val is_up : string -> bool - - (** Bring down a network device. *) - val down : string -> unit - - (** Configure a device to allow or disallow multicast. *) - val multicast : string -> bool -> unit - - (** Configure a device to respond to or ignore ARP requests. *) - val arp : string -> bool -> unit - - (** Change the name of a network device. *) - val change_name : string -> string -> unit - - (** Set MAC address of a device. *) - val set_addr : string -> string -> unit - - (** Get current speed a duplex settings for a device. *) - val get_status : string -> speed * duplex - end - -(** Module dealing with IP addresses on network devices. *) -module Addr : - sig - (** Flush all the addresses configured on a device. *) - val flush : string -> unit - - (** Get all IPV4 addresses associated with a device. *) - val get : string -> (Unix.inet_addr * Unix.inet_addr) list - end - -(** List all the interfaces on the system. *) -val list : unit -> string list - -(** Return MAC address for a network device. *) -val get_address : string -> string - -(** Get device MTU. *) -val get_mtu : string -> string - -(** Set device MTU. *) -val set_mtu : string -> int -> unit - -(** Returns the list of device names (eg physical + VLAN) which a particular MAC address. *) -val get_by_address : string -> string list - -(** Returns the PCI bus path of a device. *) -val get_pcibuspath : string -> string - -(** Returns the carrier status for a device. *) -val get_carrier : string -> bool - -(** Returns PCI vendor and device ID for network device. *) -val get_ids : string -> string * string - -(** Indicates whether the given interface is a physical interface *) -val is_physical : string -> bool - -(** Dispatch operation to correct backend device *) -val network : network_ops diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/netdev/sockios_compat.h --- a/ocaml/netdev/sockios_compat.h +++ /dev/null @@ -1,6 +0,0 @@ -/* Our dom0 chroot doesn't include up to date headers: */ - -#define SIOCBRADDBR 0x89a0 /* create new bridge device */ -#define SIOCBRDELBR 0x89a1 /* remove bridge device */ -#define SIOCBRADDIF 0x89a2 /* add interface to bridge */ -#define SIOCBRDELIF 0x89a3 /* remove interface from bridge */ diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/xapi/OMakefile --- a/ocaml/xapi/OMakefile +++ b/ocaml/xapi/OMakefile @@ -1,10 +1,10 @@ -OCAMLPACKS = xml-light2 cdrom pciutil sexpr log stunnel http-svr rss xen-utils +OCAMLPACKS = xml-light2 cdrom pciutil sexpr log stunnel http-svr rss xen-utils netdev OCAML_LIBS = ../util/version ../util/vm_memory_constraints ../util/sanitycheck ../util/stats \ ../idl/ocaml_backend/common ../idl/ocaml_backend/client ../idl/ocaml_backend/server ../util/ocamltest OCAMLINCLUDES = ../idl ../idl/ocaml_backend \ ../autogen ../database/ \ ../xenops ../xva ../util \ - ../netdev ../auth ../license ../client_records ../rfb ../gpg + ../auth ../license ../client_records ../rfb ../gpg @@ -14,7 +14,7 @@ # xen stuff at all. # NB order of libraries is important: OMake cannot determine dependencies between libraries # (the same holds for OCaml packages) -XEN_OCAML_LIBS = ../netdev/netdev ../xenops/xenops ../auth/pam +XEN_OCAML_LIBS = ../xenops/xenops ../auth/pam XEN_OCAMLINCLUDES = XEN_OCAMLPACKS = xc xs cpuid OCAML_CLIBS = $(if $(equal $(COMPILE_XENSTUFF), yes), $(XEN_OCAML_CLIBS) $(OCAML_CLIBS), $(OCAML_CLIBS)) diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/xe-cli/OMakefile --- a/ocaml/xe-cli/OMakefile +++ b/ocaml/xe-cli/OMakefile @@ -11,11 +11,10 @@ section - OCAMLPACKS += xb xs - OCAML_CLIBS = ../xenops/statdev_stubs ../netdev/netdev_stubs + OCAMLPACKS += xb xs netdev + OCAML_CLIBS = ../xenops/statdev_stubs OCamlProgram(fatxe, cli options \ - ../netdev/netdev \ ../xapi/xapi_cli \ ../xapi/pool_role \ ../xapi/helpers \ diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/xe-cli/rt/OMakefile --- a/ocaml/xe-cli/rt/OMakefile +++ b/ocaml/xe-cli/rt/OMakefile @@ -1,6 +1,6 @@ -OCAML_LIBS = ../../netdev/netdev -OCAMLINCLUDES = ../../netdev -OCAMLPACKS = str xml-light2 log +OCAML_LIBS = +OCAMLINCLUDES = +OCAMLPACKS = str xml-light2 log netdev .SUBDIRS:geneva diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/xenops-ts/OMakefile --- a/ocaml/xenops-ts/OMakefile +++ b/ocaml/xenops-ts/OMakefile @@ -1,8 +1,8 @@ -OCAMLINCLUDES = ../netdev ../xenops -OCAML_LIBS = ../util/stats ../netdev/netdev ../xenops/xenops +OCAMLINCLUDES = ../xenops +OCAML_LIBS = ../util/stats ../xenops/xenops OCAML_CLIBS += $(XEN_OCAML_CLIBS) OCAML_LINK_FLAGS += $(XEN_OCAML_LINK_FLAGS) CFLAGS += $(XEN_CFLAGS) -OCAMLPACKS = xc xs stdext log cdrom +OCAMLPACKS = xc xs stdext log cdrom netdev OCamlProgram(runtest, runtest test ../xenops/xenvmlib) diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/xenops/OMakefile --- a/ocaml/xenops/OMakefile +++ b/ocaml/xenops/OMakefile @@ -1,10 +1,10 @@ -OCAMLINCLUDES = ../netdev ../util -OCAML_LIBS = ../netdev/netdev ../util/stats +OCAMLINCLUDES = ../util +OCAML_LIBS = ../util/stats OCAML_CLIBS += $(XEN_OCAML_CLIBS) OCAML_LINK_FLAGS+= $(XEN_OCAML_LINK_FLAGS) CFLAGS += $(XEN_CFLAGS) -OCAMLPACKS = threads xc xs stdext log cdrom +OCAMLPACKS = threads xc xs stdext log cdrom netdev OCAMLFLAGS += -thread LIBFILES = xenops_helpers xenbus balloon xenguestHelper domain hotplug device io statdev xal netman memory watch device_common squeeze squeeze_xen squeezed_rpc squeezed_state squeezed_rpc @@ -42,7 +42,7 @@ OCamlProgram(dbgring, dbgring) section - OCAMLINCLUDES = ../idl/ocaml_backend ../netdev ../idl + OCAMLINCLUDES = ../idl/ocaml_backend ../idl OCAMLFLAGS = -dtypes -warn-error F -cclib -static OCAMLPACKS = xc xs OCamlProgram(xs, xenstore_readdir) diff -r d3c124fa2c15 -r b06f07f4cd08 ocaml/xiu/OMakefile --- a/ocaml/xiu/OMakefile +++ b/ocaml/xiu/OMakefile @@ -1,6 +1,6 @@ -OCAMLPACKS = stdext xs -OCAML_LIBS += ../xenops/xenops ../netdev/netdev -OCAMLINCLUDES += ../xenops ../netdev +OCAMLPACKS = stdext xs netdev +OCAML_LIBS += ../xenops/xenops +OCAMLINCLUDES += ../xenops OCamlProgram(xiu, xiu) OCamlDocProgram(xiu, xiu)
_______________________________________________ xen-api mailing list [email protected] http://lists.xensource.com/mailman/listinfo/xen-api
