--- /dev/null
+version = "@VERSION@"
+description = "Bindings to network APIs"
+requires = "stdext"
+archive(native) = "netdev.cmxa"
--- /dev/null
+CC = gcc
+CFLAGS = -Wall -fPIC -O2 -I/usr/lib/ocaml
+OCAMLC = ocamlc -g
+OCAMLOPT = ocamlopt
+
+LDFLAGS = -cclib -L./
+
+VERSION := $(shell hg parents --template "{rev}" 2>/dev/null || echo 0.0)
+OCAMLOPTFLAGS = -g -dtypes
+OCAMLFLAGS = -I ../stdext
+
+OCAMLABI := $(shell ocamlc -version)
+OCAMLLIBDIR := $(shell ocamlc -where)
+OCAMLDESTDIR ?= $(OCAMLLIBDIR)
+
+OBJS = netdev
+INTF = $(foreach obj, $(OBJS),$(obj).cmi)
+LIBS = netdev.cma netdev.cmxa
+
+DOCDIR = /myrepos/xen-api-libs.hg/doc
+
+all: $(INTF) $(LIBS) $(PROGRAMS)
+
+bins: $(PROGRAMS)
+
+libs: $(LIBS)
+
+netdev.cmxa: libnetdev_stubs.a $(foreach obj,$(OBJS),$(obj).cmx)
+ $(OCAMLOPT) $(OCAMLOPTFLAGS) $(OCAMLFLAGS) -a -o $@ -cclib -lnetdev_stubs $(foreach obj,$(OBJS),$(obj).cmx)
+
+netdev.cma: libnetdev_stubs.a $(foreach obj,$(OBJS),$(obj).cmo)
+ $(OCAMLC) $(OCAMLFLAGS) -a -dllib dllnetdev_stubs.so -cclib -lnetdev_stubs -o $@ $(foreach obj,$(OBJS),$(obj).cmo)
+
+netdev_stubs.a: addr_stubs.o bridge_stubs.o link_stubs.o
+ ocamlmklib -o netdev_stubs $+
+
+libnetdev_stubs.a: addr_stubs.o bridge_stubs.o link_stubs.o
+ ar rcs $@ $+
+ ocamlmklib -o netdev_stubs $+
+
+%.cmo: %.ml
+ $(OCAMLC) $(OCAMLFLAGS) -c -o $@ $<
+
+%.cmi: %.mli
+ $(OCAMLC) $(OCAMLFLAGS) -c -o $@ $<
+
+%.cmx: %.ml
+ $(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) -c -o $@ $<
+
+%.o: %.c
+ $(CC) $(CFLAGS) -c -o $@ $<
+
+META: META.in
+ sed 's/@VERSION@/$(VERSION)/g' < $< > $@
+
+.PHONY: install
+install: path = $(DESTDIR)$(shell ocamlfind printconf destdir)
+install: $(LIBS) META
+ mkdir -p $(path)
+ ocamlfind install -destdir $(path) -ldconf ignore netdev META $(INTF) $(LIBS) *.a *.so *.cmx
+
+.PHONY: uninstall
+uninstall:
+ ocamlfind remove netdev
+
+.PHONY: doc
+doc: $(INTF)
+ python ../doc/doc.py $(DOCDIR) "netdev" "package" "$(OBJS)" "." "" ""
+
+clean:
+ rm -f *.o *.so *.a *.cmo *.cmi *.cma *.cmx *.cmxa *.annot $(LIBS) $(PROGRAMS)
+
--- /dev/null
+/*
+ * 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);
+}
--- /dev/null
+/*
+ * 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);
+}
--- /dev/null
+/*
+ * 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
--- /dev/null
+/*
+ * 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"); \
+ }
--- /dev/null
+(*
+ * 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
--- /dev/null
+(*
+ * 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
--- /dev/null
+/* 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 */
/usr/lib/ocaml/cpuid/cpuid.cmxa
/usr/lib/ocaml/cpuid/dllcpuid_stubs.so
/usr/lib/ocaml/cpuid/libcpuid_stubs.a
+ /usr/lib/ocaml/netdev/*
/usr/lib/ocaml/eventchn/META
/usr/lib/ocaml/eventchn/dlleventchn_stubs.so
/usr/lib/ocaml/eventchn/eventchn.a
projects / xcp / xen-api-libs.git / commitdiff