xva \
guest \
console \
- netdev \
auth \
events \
in_guest_install \
-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
+++ /dev/null
-OCamlLibraryClib(netdev, netdev, netdev_stubs)
-StaticCLibrary(netdev_stubs, bridge_stubs link_stubs addr_stubs)
-OCamlDocLibrary(netdev, netdev)
-
-OCAML_LIBS += netdev
+++ /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 */
-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
# 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))
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 \
-OCAML_LIBS = ../../netdev/netdev
-OCAMLINCLUDES = ../../netdev
-OCAMLPACKS = str xml-light2 log
+OCAML_LIBS =
+OCAMLINCLUDES =
+OCAMLPACKS = str xml-light2 log netdev
.SUBDIRS:geneva
-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)
-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
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)
-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)
projects / xcp / xen-api.git / commitdiff