(* $Id: rpc_auth_local.ml 2195 2015-01-01 12:23:39Z gerd $
 * ----------------------------------------------------------------------
 *
 *)

external get_peer_credentials : Unix.file_descr -> (int * int)
  = "netsys_get_peer_credentials"
;;

(*
external peek_peer_credentials : Unix.file_descr -> (int * int)
  = "netsys_peek_peer_credentials"
;;
*
 *)


class server_auth_method : Rpc_server.auth_method =
object
  method name = "AUTH_LOCAL"
  method flavors = [ ]
  method peek =
    `Peek_descriptor
      (fun d ->
	 match Netsys.getpeername d with
	     Unix.ADDR_UNIX _ ->
	       (* Try now peek_peer_credentials: *)
	       begin try
		 let uid, gid = get_peer_credentials d in
		 let username =
		   string_of_int uid ^ "." ^ string_of_int gid ^ "@localhost" in
		 Some username
	       with
		   Invalid_argument _ ->
		     (* peek_peer_credentials is not available for this OS *)
		     None
		 | Not_found ->
		     (* Some other failure *)
		     None
		 | Unix.Unix_error(Unix.EAGAIN,_,_) ->
		     (* peek_peer_credentials expects that there is a message
                      * to read. EAGAIN is raised if we call it in the wrong
                      * moment.
                      *)
		     None
	       end
	   | _ ->
	       None
      )

  method authenticate _ _ _ _ = ()
  method invalidate() = ()
  method invalidate_connection _ = ()
end



let server_auth_method() = new server_auth_method