From d638081251cff723673bd9390f638dc806dd0027 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Fri, 31 May 2024 10:12:21 +0200 Subject: [PATCH 1/4] tftp: Remove legacy dependency on error logger --- lib/tftp/src/tftp_engine.erl | 4 ++-- lib/tftp/src/tftp_logger.erl | 18 +++++++++--------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/lib/tftp/src/tftp_engine.erl b/lib/tftp/src/tftp_engine.erl index 495fbd3565cd..1b5a31d24345 100644 --- a/lib/tftp/src/tftp_engine.erl +++ b/lib/tftp/src/tftp_engine.erl @@ -646,7 +646,7 @@ common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, end; common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared) when ActualBlockNo =< ExpectedBlockNo, is_record(Prepared, prepared) -> - %% error_logger:error_msg("TFTP READ ~s: Expected block ~p but got block ~p - IGNORED\n", + %% logger:error("TFTP READ ~s: Expected block ~p but got block ~p - IGNORED\n", %% [Req#tftp_msg_req.filename, ExpectedBlockNo, ActualBlockNo]), case Prepared of #prepared{status = more, prev_data = Data} when is_binary(Data) -> @@ -707,7 +707,7 @@ common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, common_ack(Config, Callback, Req, LocalAccess, ExpectedBlockNo - 1, Prepared); common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared) when ActualBlockNo =< ExpectedBlockNo, is_binary(Data), is_record(Prepared, prepared) -> - %% error_logger:error_msg("TFTP WRITE ~s: Expected block ~p but got block ~p - IGNORED\n", + %% logger:error("TFTP WRITE ~s: Expected block ~p but got block ~p - IGNORED\n", %% [Req#tftp_msg_req.filename, ExpectedBlockNo, ActualBlockNo]), Reply = #tftp_msg_ack{block_no = ExpectedBlockNo}, {Config2, Callback2, TransferRes} = diff --git a/lib/tftp/src/tftp_logger.erl b/lib/tftp/src/tftp_logger.erl index 3f2fb708fdb8..90b2c22e4129 100644 --- a/lib/tftp/src/tftp_logger.erl +++ b/lib/tftp/src/tftp_logger.erl @@ -38,15 +38,15 @@ and export the following functions: info_msg/2 ]). --doc "Logs a warning message. See `error_logger:warning_msg/2` for details.". +-doc "Logs a warning message. See `logger:warning/2` for details.". -doc(#{since => <<"OTP 18.1">>}). --callback warning_msg(Format :: string(), Data :: [term()]) -> ok. --doc "Logs an info message. See `error_logger:info_msg/2` for details.". +-callback warning_msg(Format :: io:format(), Args :: [term()]) -> ok. +-doc "Logs an info message. See `logger:info/2` for details.". -doc(#{since => <<"OTP 18.1">>}). --callback info_msg(Format :: string(), Data :: [term()]) -> ok. --doc "Logs an error message. See `error_logger:error_msg/2` for details.". +-callback info_msg(Format :: io:format(), Args :: [term()]) -> ok. +-doc "Logs an error message. See `logger:error/2` for details.". -doc(#{since => <<"OTP 18.1">>}). --callback error_msg(Format :: string(), Data :: [term()]) -> ok. +-callback error_msg(Format :: io:format(), Args :: [term()]) -> ok. -optional_callbacks([warning_msg/2, error_msg/2, info_msg/2]). @@ -63,7 +63,7 @@ and export the following functions: -doc false. error_msg(Format, Data) -> {Format2, Data2} = add_timestamp(Format, Data), - error_logger:error_msg(Format2, Data2). + logger:error(Format2, Data2). %%------------------------------------------------------------------- %% warning_msg(Format, Data) -> ok | exit(Reason) @@ -78,7 +78,7 @@ error_msg(Format, Data) -> -doc false. warning_msg(Format, Data) -> {Format2, Data2} = add_timestamp(Format, Data), - error_logger:warning_msg(Format2, Data2). + logger:warning(Format2, Data2). %%------------------------------------------------------------------- %% info_msg(Format, Data) -> ok | exit(Reason) @@ -93,7 +93,7 @@ warning_msg(Format, Data) -> -doc false. info_msg(Format, Data) -> {Format2, Data2} = add_timestamp(Format, Data), - io:format(Format2, Data2). + logger:info(Format2, Data2). %%------------------------------------------------------------------- %% Add timestamp to log message From f62ce9a8b01a01e4269137fd870aa1959d422490 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Fri, 31 May 2024 14:38:06 +0200 Subject: [PATCH 2/4] tftp: Polish doc --- lib/tftp/src/tftp.erl | 552 ++++++++++++------------------------------ 1 file changed, 149 insertions(+), 403 deletions(-) diff --git a/lib/tftp/src/tftp.erl b/lib/tftp/src/tftp.erl index 3596d8db2618..fb70df0d0493 100644 --- a/lib/tftp/src/tftp.erl +++ b/lib/tftp/src/tftp.erl @@ -25,209 +25,136 @@ %%% Description : Trivial FTP %%% Created : 18 May 2004 by Hakan Mattsson %%%------------------------------------------------------------------- -%%% -%%% This is a complete implementation of the following IETF standards: -%%% -%%% RFC 1350, The TFTP Protocol (revision 2). -%%% RFC 2347, TFTP Option Extension. -%%% RFC 2348, TFTP Blocksize Option. -%%% RFC 2349, TFTP Timeout Interval and Transfer Size Options. -%%% -%%% The only feature that not is implemented in this release is -%%% the "netascii" transfer mode. -%%% -%%% The start/1 function starts a daemon process which, listens for -%%% UDP packets on a port. When it receives a request for read or -%%% write it spawns a temporary server process which handles the -%%% actual transfer of the file. On the client side the read_file/3 -%%% and write_file/3 functions spawns a temporary client process which -%%% establishes contact with a TFTP daemon and performs the actual -%%% transfer of the file. -%%% -%%% Most of the options are common for both the client and the server -%%% side, but some of them differs a little. Here are the available -%%% options: -%%% -%%% {debug, Level} -%%% -%%% Level = none | error | warning brief | normal | verbose | all -%%% -%%% Controls the level of debug printouts. The default is none. -%%% -%%% {host, Host} -%%% -%%% The name or IP address of the host where the TFTP daemon -%%% resides. This option is only used by the client. See -%%% 'inet' about valid host names. -%%% -%%% {port, Port} -%%% -%%% Port = integer() -%%% -%%% The TFTP port where the daemon listens. It defaults to the -%%% standardized number 69. On the server side it may sometimes -%%% make sense to set it to 0, which means that the daemon just -%%% will pick a free port (which is returned by the start/1 -%%% function). -%%% -%%% If a socket has somehow already has been connected, the -%%% {udp, [{fd, integer()}]} option can be used to pass the -%%% open file descriptor to gen_udp. This can be automated -%%% a bit by using a command line argument stating the -%%% prebound file descriptor number. For example, if the -%%% Port is 69 and the file descriptor 22 has been opened by -%%% setuid_socket_wrap. Then the command line argument -%%% "-tftpd_69 22" will trigger the prebound file -%%% descriptor 22 to be used instead of opening port 69. -%%% The UDP option {udp, [{fd, 22}]} automatically be added. -%%% See init:get_argument/ about command line arguments and -%%% gen_udp:open/2 about UDP options. -%%% -%%% {port_policy, Policy} -%%% -%%% Policy = random | Port | {range, MinPort, MaxPort} -%%% Port = MinPort = MaxPort = integer() -%%% -%%% Policy for the selection of the temporary port which is used -%%% by the server/client during the file transfer. It defaults to -%%% 'random' which is the standardized policy. With this policy a -%%% randomized free port used. A single port or a range of ports -%%% can be useful if the protocol should pass thru a firewall. -%%% -%%% {prebound_fd, InitArgFlag} -%%% -%%% InitArgFlag = atom() -%%% -%%% If a socket has somehow already has been connected, the -%%% {udp, [{fd, integer()}]} option can be used to pass the -%%% open file descriptor to gen_udp. -%%% -%%% The prebound_fd option makes it possible to pass give the -%%% file descriptor as a command line argument. The typical -%%% usage is when used in conjunction with setuid_socket_wrap -%%% to be able to open privileged sockets. For example if the -%%% file descriptor 22 has been opened by setuid_socket_wrap -%%% and you have chosen my_tftp_fd as init argument, the -%%% command line should like this "erl -my_tftp_fd 22" and -%%% FileDesc should be set to my_tftpd_fd. This would -%%% automatically imply {fd, 22} to be set as UDP option. -%%% -%%% {udp, UdpOptions} -%%% -%%% Options to gen_udp:open/2. -%%% -%%% {use_tsize, Bool} -%%% -%%% Bool = boolean() -%%% -%%% Flag for automated usage of the "tsize" option. With this set -%%% to true, the write_file/3 client will determine the filesize -%%% and send it to the server as the standardized "tsize" option. -%%% A read_file/3 client will just acquire filesize from the -%%% server by sending a zero "tsize". -%%% -%%% {max_tsize, MaxTsize} -%%% -%%% MaxTsize = integer() | infinity -%%% -%%% Threshold for the maximal filesize in bytes. The transfer will -%%% be aborted if the limit is exceeded. It defaults to -%%% 'infinity'. -%%% -%%% {max_conn, MaxConn} -%%% -%%% MaxConn = integer() | infinity -%%% -%%% Threshold for the maximal number of active connections. The -%%% daemon will reject the setup of new connections if the limit -%%% is exceeded. It defaults to 'infinity'. -%%% -%%% {TftpKey, TftpVal} -%%% -%%% TftpKey = string() -%%% TftpVal = string() -%%% -%%% The name and value of a TFTP option. -%%% -%%% {reject, Feature} -%%% -%%% Feature = Mode | TftpKey -%%% Mode = read | write -%%% TftpKey = string() -%%% -%%% Control which features that should be rejected. -%%% This is mostly useful for the server as it may restrict -%%% usage of certain TFTP options or read/write access. -%%% -%%% {callback, {RegExp, Module, State}} -%%% -%%% RegExp = string() -%%% Module = atom() -%%% State = term() -%%% -%%% Registration of a callback module. When a file is to be -%%% transferred, its local filename will be matched to the -%%% regular expressions of the registered callbacks. The first -%%% matching callback will be used the during the transfer.The -%%% callback module must implement the 'tftp' behaviour. -%%% -%%% On the server side the callback interaction starts with a -%%% call to open/5 with the registered initial callback -%%% state. open/5 is expected to open the (virtual) file. Then -%%% either the read/1 or write/2 functions are invoked -%%% repeatedly, once per transfererred block. At each function -%%% call the state returned from the previous call is -%%% obtained. When the last block has been encountered the read/1 -%%% or write/2 functions is expected to close the (virtual) -%%% file.and return its last state. The abort/3 function is only -%%% used in error situations. prepare/5 is not used on the server -%%% side. -%%% -%%% On the client side the callback interaction is the same, but -%%% it starts and ends a bit differently. It starts with a call -%%% to prepare/5 with the same arguments as open/5 -%%% takes. prepare/5 is expected to validate the TFTP options, -%%% suggested by the user and return the subset of them that it -%%% accepts. Then the options is sent to the server which will -%%% perform the same TFTP option negotiation procedure. The -%%% options that are accepted by the server is forwarded to the -%%% open/5 function on the client side. On the client side the -%%% open/5 function must accept all option as is or reject the -%%% transfer. Then the callback interaction follows the same -%%% pattern as described above for the server side. When the last -%%% block is encountered in read/1 or write/2 the returned stated -%%% is forwarded to the user and returned from read_file/3 or -%%% write_file/3. -%%%------------------------------------------------------------------- - -module(tftp). + +-moduledoc(#{titles => + [{function,<<"Client API">>}, + {function,<<"Server API">>} + ]} + ). + -moduledoc """ Trivial FTP. Interface module for the `tftp` application. -[](){: #options } +## Overwiew + +This is a complete implementation of the following IETF standards: + RFC 1350, The TFTP Protocol (revision 2). + RFC 2347, TFTP Option Extension. + RFC 2348, TFTP Blocksize Option. + RFC 2349, TFTP Timeout Interval and Transfer Size Options. + +The only feature that not is implemented in this release is +the "netascii" transfer mode. + +The [start/](`start/3`)function starts a daemon process which, listens +for UDP packets on a port. When it receives a request for read or +write it spawns a temporary server process which handles the actual +transfer of the file. On the client side the +[read_file/3](`read_file/3`) and [write_file/3](`write_file/3`) +functions spawns a temporary client process which establishes contact +with a TFTP daemon and performs the actual transfer of the file. + +Most of the options are common for both the client and the server +side, but some of them differs a little. + +## Callbacks + +A `tftp` callback module is to be implemented as a `tftp` behavior and export +the functions listed in the following. + +On the server side, the callback interaction starts with a call to `open/5` with +the registered initial callback state. `open/5` is expected to open the +(virtual) file. Then either function [`Module:read/1`](`c:read/1`) or +[`Module:write/2`](`c:write/2`) is invoked repeatedly, once per transferred block. At +each function call, the state returned from the previous call is obtained. When +the last block is encountered, function [`Module:read/1`](`c:read/1`) or +[`Module:write/2`](`c:write/2`) is expected to close the (virtual) file and return its +last state. Function [`Module:abort/3`](`c:abort/3`) is only used in error situations. +Function `prepare/5` is not used on the server side. + +On the client side, the callback interaction is the same, but it starts and ends +a bit differently. It starts with a call to `prepare/5` with the same arguments +as `open/5` takes. `prepare/5` is expected to validate the TFTP options +suggested by the user and to return the subset of them that it accepts. Then the +options are sent to the server, which performs the same TFTP option negotiation +procedure. The options that are accepted by the server are forwarded to function +`open/5` on the client side. On the client side, function `open/5` must accept +all option as-is or reject the transfer. Then the callback interaction follows +the same pattern as described for the server side. When the last block is +encountered in [`Module:read/1`](`c:read/1`) or [`Module:write/2`](`c:write/2`), the returned +state is forwarded to the user and returned from `read_file`/3 or +[`write_file/3`](`write_file/3`). + +If a callback (performing the file access in the TFTP server) takes too long +time (more than the double TFTP time-out), the server aborts the connection and +sends an error reply to the client. The server simply +assumes that the client has given up. + +If the TFTP server receives yet another request from the same client (same host +and port) while it already has an active connection to the client, it ignores +the new request if the request is equal to the first one (same filename and +options). This implies that the (new) client will be served by the already +ongoing connection on the server side. By not setting up yet another connection, +in parallel with the ongoing one, the server consumes less resources. + +[](){: #prepare } +""". + +%%------------------------------------------------------------------- +%% Interface +%%------------------------------------------------------------------- + +%% Public functions +-export([ + read_file/3, + write_file/3, + start/1, + info/1, + change_config/2, + start/0, + stop/0 + ]). + +%% Application local functions +-export([ + start_standalone/1, + start_service/1, + stop_service/1, + services/0, + service_info/1 + ]). -## DATA TYPES +-export_type([option/0]). -`ServiceConfig = Options` +-include("tftp.hrl"). -`Options = [option()]` +-doc """ +Information about the peer provided for callback. +""". +-type peer() :: {PeerType :: inet | inet6, + PeerHost :: inet:ip_address(), + PeerPort :: port()}. +-doc """ +Access mode. +""". +-type access() :: read | write. -Most of the options are common for both the client and the server side, but some -of them differs a little. The available `option()`s are as follows: +-doc """ +All options most of them common to the client and server. -- **`{debug, Level}`** - - `Level = none | error | warning | brief | normal | verbose | all` +- **`{debug, Level::none | error | warning | brief | normal | verbose | all}`** Controls the level of debug printouts. Default is `none`. -- **`{host, Host}`** - `Host = hostname()`, see `m:inet`. +- **`{host, Host::inet:hostname()}`** - The name or IP address of the host where the TFTP daemon resides. This option is only used by the client. -- **`{port, Port}`** - `Port = int()` +- **`{port, Port::inet:port_number()}`** The TFTP port where the daemon listens. Defaults is the standardized number 69. On the server side, it can sometimes make sense to set it to 0, @@ -243,10 +170,7 @@ of them differs a little. The available `option()`s are as follows: option `{udp, [{fd, 22}]}` is automatically added. See `init:get_argument/` about command-line arguments and `gen_udp:open/2` about UDP options. -- **`{port_policy, Policy}`** - - `Policy = random | Port | {range, MinPort, MaxPort}` - - `Port = MinPort = MaxPort = int()` +- **`{port_policy, random | inet:port_number() | {range, Min::inet:port_number(), Max::inet:port_nuber()}`** Policy for the selection of the temporary port that is used by the server/client during the file transfer. Default is `random`, which is the @@ -254,10 +178,9 @@ of them differs a little. The available `option()`s are as follows: port or a range of ports can be useful if the protocol passes through a firewall. -- **`{udp, Options}`** - `Options = [Opt]`, see - [gen_udp:open/2](`gen_udp:open/1`). +- **`{udp, Options::gen_udp:option}`** -- **`{use_tsize, Bool}`** - `Bool = bool()` +- **`{use_tsize, boolean()}`** Flag for automated use of option `tsize`. With this set to `true`, the [`write_file/3`](`write_file/3`) client determines the filesize and sends it @@ -265,31 +188,26 @@ of them differs a little. The available `option()`s are as follows: [`read_file/3`](`read_file/3`) client acquires only a filesize from the server by sending a zero `tsize`. -- **`{max_tsize, MaxTsize}`** - `MaxTsize = int() | infinity` +- **`{max_tsize, MaxTsize::pos_integer() | infinity}`** Threshold for the maximal filesize in bytes. The transfer is aborted if the limit is exceeded. Default is `infinity`. -- **`{max_conn, MaxConn}`** - `MaxConn = int() | infinity` +- **`{max_conn, MaxConn::pos_integer() | infinity}`** Threshold for the maximal number of active connections. The daemon rejects the setup of new connections if the limit is exceeded. Default is `infinity`. -- **`{TftpKey, TftpVal}`** - `TftpKey = string()` - `TftpVal = string()` +- **TftpOption::option()** Name and value of a TFTP option. -- **`{reject, Feature}`** - `Feature = Mode | TftpKey` - ` Mode = read | write` - ` TftpKey = string()` +- **`{reject, Feature:: access() | TftpKey::string()}`** Controls which features to reject. This is mostly useful for the server as it can restrict the use of certain TFTP options or read/write access. -- **`{callback, {RegExp, Module, State}}`** - `RegExp = string()` - `Module = atom()` - `State = term()` +- **`{callback, {RegExp ::string(), Module::module(), State :: term()}}`** Registration of a callback module. When a file is to be transferred, its local filename is matched to the regular expressions of the registered callbacks. @@ -299,102 +217,32 @@ of them differs a little. The available `option()`s are as follows: The callback module must implement the `tftp` behavior, see [CALLBACK FUNCTIONS](`m:tftp#tftp_callback`). -- **`{logger, Module}`** - `Module = module()` +- **`{logger, module()}`** Callback module for customized logging of errors, warnings, and info messages. The callback module must implement the `m:tftp_logger` behavior. The default module is `tftp_logger`. -- **`{max_retries, MaxRetries}`** - `MaxRetries = int()` +- **`{max_retries, MaxRetries::non_neg_integer()}`** Threshold for the maximal number of retries. By default the server/client tries to resend a message up to five times when the time-out expires. - -[](){: #tftp_callback } - -## CALLBACK FUNCTIONS - -A `tftp` callback module is to be implemented as a `tftp` behavior and export -the functions listed in the following. - -On the server side, the callback interaction starts with a call to `open/5` with -the registered initial callback state. `open/5` is expected to open the -(virtual) file. Then either function [`read/1`](`c:read/1`) or -[`write/2`](`c:write/2`) is invoked repeatedly, once per transferred block. At -each function call, the state returned from the previous call is obtained. When -the last block is encountered, function [`read/1`](`c:read/1`) or -[`write/2`](`c:write/2`) is expected to close the (virtual) file and return its -last state. Function [`abort/3`](`c:abort/3`) is only used in error situations. -Function `prepare/5` is not used on the server side. - -On the client side, the callback interaction is the same, but it starts and ends -a bit differently. It starts with a call to `prepare/5` with the same arguments -as `open/5` takes. `prepare/5` is expected to validate the TFTP options -suggested by the user and to return the subset of them that it accepts. Then the -options are sent to the server, which performs the same TFTP option negotiation -procedure. The options that are accepted by the server are forwarded to function -`open/5` on the client side. On the client side, function `open/5` must accept -all option as-is or reject the transfer. Then the callback interaction follows -the same pattern as described for the server side. When the last block is -encountered in [`read/1`](`c:read/1`) or [`write/2`](`c:write/2`), the returned -state is forwarded to the user and returned from `read_file`/3 or -[`write_file/3`](`write_file/3`). - -If a callback (performing the file access in the TFTP server) takes too long -time (more than the double TFTP time-out), the server aborts the connection and -sends an error reply to the client. This implies that the server releases -resources attached to the connection faster than before. The server simply -assumes that the client has given up. - -If the TFTP server receives yet another request from the same client (same host -and port) while it already has an active connection to the client, it ignores -the new request if the request is equal to the first one (same filename and -options). This implies that the (new) client will be served by the already -ongoing connection on the server side. By not setting up yet another connection, -in parallel with the ongoing one, the server consumes less resources. - -[](){: #prepare } """. +-type connection_option() :: {atom(), term()} | option(). -%%------------------------------------------------------------------- -%% Interface -%%------------------------------------------------------------------- - -%% Public functions --export([ - read_file/3, - write_file/3, - start/1, - info/1, - change_config/2, - start/0, - stop/0 - ]). - -%% Application local functions --export([ - start_standalone/1, - start_service/1, - stop_service/1, - services/0, - service_info/1 - ]). - --include("tftp.hrl"). - --type peer() :: {PeerType :: inet | inet6, - PeerHost :: inet:ip_address(), - PeerPort :: port()}. - --type access() :: read | write. - --type option() :: {Key :: string(), Value :: string()}. - +-doc """ +Error reason codes. +""". -type error_code() :: undef | enoent | eacces | enospc | badop | eexist | baduser | badopt | - integer(). + pos_integer(). + + +-doc """ +Specific TFTP protocol options +""". +-type option() :: {string(), Value :: string()}. --export_type([option/0]). -doc """ Prepares to open a file on the client side. @@ -432,7 +280,9 @@ with new values in `AcceptedOptions`. [](){: #read } """. --doc(#{since => <<"OTP 18.1">>}). + +-doc(#{title => <<"Client API">>, + since => <<"OTP 18.1">>}). -callback open(Peer :: peer(), Access :: access(), Filename :: file:name(), @@ -487,34 +337,8 @@ However, it is invoked if the functions fail (crash). -doc(#{since => <<"OTP 18.1">>}). -callback abort(Code :: error_code(), string(), State :: term()) -> 'ok'. -%%------------------------------------------------------------------- -%% read_file(RemoteFilename, LocalFilename, Options) -> -%% {ok, LastCallbackState} | {error, Reason} -%% -%% RemoteFilename = string() -%% LocalFilename = binary | string() -%% Options = [option()] -%% LastCallbackState = term() -%% Reason = term() -%% -%% Reads a (virtual) file from a TFTP server -%% -%% If LocalFilename is the atom 'binary', tftp_binary will be used as -%% callback module. It will concatenate all transferred blocks and -%% return them as one single binary in the CallbackState. -%% -%% When LocalFilename is a string, it will be matched to the -%% registered callback modules and hopefully one of them will be -%% selected. By default, tftp_file will be used as callback module. It -%% will write each transferred block to the file named -%% LocalFilename. The number of transferred bytes will be returned as -%% LastCallbackState. -%%------------------------------------------------------------------- - +-doc(#{title => <<"Client API">>}). -doc """ -read_file(RemoteFilename, LocalFilename, Options) -> {ok, LastCallbackState} | -{error, Reason} - Reads a (virtual) file `RemoteFilename` from a TFTP server. If `LocalFilename` is the atom `binary`, `tftp_binary` is used as callback @@ -536,40 +360,16 @@ matching regexp is found. {ok, LastCallbackState} | {error, Reason} when RemoteFilename :: file:filename(), LocalFilename :: file:filename_all(), - Options :: [option()], + Options :: [connection_option()], LastCallbackState :: term(), Reason :: term(). read_file(RemoteFilename, LocalFilename, Options) -> tftp_engine:client_start(read, RemoteFilename, LocalFilename, Options). -%%------------------------------------------------------------------- -%% write(RemoteFilename, LocalFilename, Options) -> -%% {ok, LastCallbackState} | {error, Reason} -%% -%% RemoteFilename = string() -%% LocalFilename = binary() | string() -%% Options = [option()] -%% LastCallbackState = term() -%% Reason = term() -%% -%% Writes a (virtual) file to a TFTP server -%% -%% If LocalFilename is a binary, tftp_binary will be used as callback -%% module. The binary will be transferred block by block and the number -%% of transferred bytes will be returned as LastCallbackState. -%% -%% When LocalFilename is a string, it will be matched to the -%% registered callback modules and hopefully one of them will be -%% selected. By default, tftp_file will be used as callback module. It -%% will read the file named LocalFilename block by block. The number -%% of transferred bytes will be returned as LastCallbackState. -%%------------------------------------------------------------------- +-doc(#{title => <<"Client API">>}). -doc """ -write_file(RemoteFilename, LocalFilename, Options) -> {ok, LastCallbackState} | -{error, Reason} - Writes a (virtual) file `RemoteFilename` to a TFTP server. If `LocalFilename` is a binary, `tftp_binary` is used as callback module. The @@ -590,7 +390,7 @@ matching regexp is found. -spec write_file(RemoteFilename, LocalFilename, Options) -> {ok, LastCallbackState} | {error, Reason} when RemoteFilename :: file:filename(), - LocalFilename :: file:filename_all(), + LocalFilename :: file:filename_all() | binary, Options :: [option()], LastCallbackState :: term(), Reason :: term(). @@ -598,97 +398,43 @@ matching regexp is found. write_file(RemoteFilename, LocalFilename, Options) -> tftp_engine:client_start(write, RemoteFilename, LocalFilename, Options). -%%------------------------------------------------------------------- -%% start(Options) -> {ok, Pid} | {error, Reason} -%% -%% Options = [option()] -%% Pid = pid() -%% Reason = term() -%% -%% Starts a daemon process which listens for udp packets on a -%% port. When it receives a request for read or write it spawns -%% a temporary server process which handles the actual transfer -%% of the (virtual) file. -%%------------------------------------------------------------------- - +-doc(#{title => <<"Server API">>}). -doc """ -start(Options) -> {ok, Pid} | {error, Reason} +Starts a daemon process listening for UDP packets on a port. -Starts a daemon process listening for UDP packets on a port. When it receives a -request for read or write, it spawns a temporary server process handling the -actual transfer of the (virtual) file. +When it receives a request for read or write, it spawns a temporary +server process handling the actual transfer of the (virtual) file. """. -spec start(Options) -> {ok, Pid} | {error, Reason} when - Options :: [option()], + Options :: [connection_option()], Pid :: pid(), Reason :: term(). start(Options) -> tftp_engine:daemon_start(Options). -%%------------------------------------------------------------------- -%% info(Pid) -> {ok, Options} | {error, Reason} -%% -%% Options = [option()] -%% Reason = term() -%% -%% Returns info about a tftp daemon, server or client process -%%------------------------------------------------------------------- +-doc(#{title => <<"Server API">>}). -doc """ -info(Pid) -> {ok, Options} | {error, Reason} - -Returns information about all TFTP daemon processes. - -Returns information about all TFTP server processes. - -Returns information about a TFTP daemon, server, or client process. +Returns information about all TFTP server. """. info(Pid) -> tftp_engine:info(Pid). -%%------------------------------------------------------------------- -%% change_config(Pid, Options) -> ok | {error, Reason} -%% -%% Options = [option()] -%% Reason = term() -%% -%% Changes config for a tftp daemon, server or client process -%% Must be used with care. -%%------------------------------------------------------------------- +-doc(#{title => <<"Server API">>}). -doc """ -change_config(Pid, Options) -> Result - -Changes configuration for all TFTP daemon processes. - -Changes configuration for all TFTP server processes. - -Changes configuration for a TFTP daemon, server, or client process. +Changes configuration a TFTP Server """. change_config(Pid, Options) -> tftp_engine:change_config(Pid, Options). -%%------------------------------------------------------------------- -%% start() -> ok | {error, Reason} -%% -%% Reason = term() -%% -%% Start the application -%%------------------------------------------------------------------- -doc false. start() -> application:start(tftp). -%%------------------------------------------------------------------- -%% stop() -> ok | {error, Reason} -%% -%% Reason = term() -%% -%% Stop the application -%%------------------------------------------------------------------- -doc false. stop() -> application:stop(tftp). From f15d5c92f1d64b0e3705560a6ae4250f28861f83 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Fri, 31 May 2024 15:11:43 +0200 Subject: [PATCH 3/4] tftp: Remove dead legacy code --- lib/tftp/src/tftp.erl | 35 ----------------------------------- lib/tftp/test/tftp_SUITE.erl | 33 +-------------------------------- 2 files changed, 1 insertion(+), 67 deletions(-) diff --git a/lib/tftp/src/tftp.erl b/lib/tftp/src/tftp.erl index fb70df0d0493..985b67a54968 100644 --- a/lib/tftp/src/tftp.erl +++ b/lib/tftp/src/tftp.erl @@ -118,15 +118,6 @@ in parallel with the ongoing one, the server consumes less resources. stop/0 ]). -%% Application local functions --export([ - start_standalone/1, - start_service/1, - stop_service/1, - services/0, - service_info/1 - ]). - -export_type([option/0]). -include("tftp.hrl"). @@ -439,29 +430,3 @@ start() -> stop() -> application:stop(tftp). -%%------------------------------------------------------------------- -%% Inets service behavior -%%------------------------------------------------------------------- - --doc false. -start_standalone(Options) -> - start(Options). - --doc false. -start_service(Options) -> - tftp_sup:start_child(Options). - --doc false. -stop_service(Pid) -> - tftp_sup:stop_child(Pid). - --doc false. -services() -> - tftp_sup:which_children(). - --doc false. -service_info(Pid) -> - info(Pid). - - - diff --git a/lib/tftp/test/tftp_SUITE.erl b/lib/tftp/test/tftp_SUITE.erl index 35582a4388ea..bf74b7a56eee 100644 --- a/lib/tftp/test/tftp_SUITE.erl +++ b/lib/tftp/test/tftp_SUITE.erl @@ -84,8 +84,7 @@ all() -> resend_server, large_file, app, - appup, - start_tftpd + appup ]. groups() -> @@ -115,36 +114,6 @@ appup() -> appup(Config) when is_list(Config) -> ok = test_server:appup_test(tftp). -start_tftpd() -> - [{doc, "Start/stop of tfpd service"}]. -start_tftpd(Config) when is_list(Config) -> - process_flag(trap_exit, true), - ok = tftp:start(), - {ok, Pid0} = tftp:start_service([{host, "localhost"}, {port, 0}]), - Pids0 = [ServicePid || {_, ServicePid} <- tftp:services()], - true = lists:member(Pid0, Pids0), - {ok, [_|_]} = tftp:service_info(Pid0), - tftp:stop_service(Pid0), - ct:sleep(100), - Pids1 = [ServicePid || {_, ServicePid} <- tftp:services()], - false = lists:member(Pid0, Pids1), - - {ok, Pid1} = - tftp:start_standalone([{host, "localhost"}, {port, 0}]), - Pids2 = [ServicePid || {_, ServicePid} <- tftp:services()], - false = lists:member(Pid1, Pids2), - %% Standalone service is not supervised - {error,not_found} = tftp:stop_service(Pid1), - ok = tftp:stop(), - - application:load(tftp), - application:set_env(tftp, services, [{tftpd, [{host, "localhost"}, - {port, 0}]}]), - ok = tftp:start(), - 1 = length(tftp:services()), - application:unset_env(tftp, services), - ok = tftp:stop(). - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Simple From 8e978dcd82eb1508fe857729c794275ad5103a31 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Fri, 31 May 2024 15:41:59 +0200 Subject: [PATCH 4/4] tfpt: polish user guides --- lib/tftp/doc/guides/getting_started.md | 16 +---------- lib/tftp/doc/guides/introduction.md | 40 ++++++++++++-------------- lib/tftp/src/tftp.erl | 2 +- 3 files changed, 21 insertions(+), 37 deletions(-) diff --git a/lib/tftp/doc/guides/getting_started.md b/lib/tftp/doc/guides/getting_started.md index fab5f7b2b320..e9112a87f82f 100644 --- a/lib/tftp/doc/guides/getting_started.md +++ b/lib/tftp/doc/guides/getting_started.md @@ -17,27 +17,13 @@ limitations under the License. %CopyrightEnd% --> -# Getting Started +# Examples -## General Information The [start/1](`tftp:start/1`) function starts a daemon process listening for UDP packets on a port. When it receives a request for read or write, it spawns a temporary server process handling the transfer. -On the client side, function [read_file/3](`tftp:read_file/3`) and -[write_file/3](`tftp:write_file/3`) spawn a temporary client process -establishing contact with a TFTP daemon and perform the file transfer. - -`tftp` uses a callback module to handle the file transfer. Two such callback -modules are provided, `tftp_binary` and `tftp_file`. See -[read_file/3](`tftp:read_file/3`) and [write_file/3](`tftp:write_file/3`) for -details. You can also implement your own callback modules, see -[CALLBACK FUNCTIONS](`m:tftp#tftp_callback`). A callback module provided by the -user is registered using option `callback`, see [DATA TYPES](`m:tftp#options`). - -## Using the TFTP client and server - This is a simple example of starting the TFTP server and reading the content of a sample file using the TFTP client. diff --git a/lib/tftp/doc/guides/introduction.md b/lib/tftp/doc/guides/introduction.md index 1b4e2a870b2d..55d35bdc69d6 100644 --- a/lib/tftp/doc/guides/introduction.md +++ b/lib/tftp/doc/guides/introduction.md @@ -17,30 +17,28 @@ limitations under the License. %CopyrightEnd% --> -# Introduction +# Overview -## Purpose +Trivial File Transfer Protocol (TFTP) is a very simple protocol used +to transfer files over the transport datagram protocol UDP. -The Trivial File Transfer Protocol or TFTP is a very simple protocol used to -transfer files. +On the client side, function [read_file/3](`tftp:read_file/3`) and +[write_file/3](`tftp:write_file/3`) spawn a temporary client process +establishing contact with a TFTP daemon and perform the file transfer. -It has been implemented on top of the User Datagram protocol (UDP) so it may be -used to move files between machines on different networks implementing UDP. It -is designed to be small and easy to implement. Therefore, it lacks most of the -features of a regular FTP. The only thing it can do is read and write files (or -mail) from/to a remote server. It cannot list directories, and currently has no -provisions for user authentication. +`tftp` uses a callback module to handle the file transfer. Two such callback +modules are provided, `tftp_binary` and `tftp_file`. See +[read_file/3](`tftp:read_file/3`) and [write_file/3](`tftp:write_file/3`) for +details. You can also implement your own callback modules, see +[callbacks](`m:tftp#callbacks`). -The `tftp` application implements the following IETF standards: +# Security Considerations -- RFC 1350, The TFTP Protocol (revision 2) -- RFC 2347, TFTP Option Extension -- RFC 2348, TFTP Blocksize Option -- RFC 2349, TFTP Timeout Interval and Transfer Size Options +As stated in ([RFC 1350](https://datatracker.ietf.org/doc/html/rfc1350)) +be aware that "Since TFTP includes no login or access +control mechanisms, care must be taken in the rights granted to a TFTP +server process so as not to violate the security of the server hosts +file system. TFTP is often installed with controls such that only +files that have public read access are available via TFTP and writing +files via TFTP is disallowed." -The only feature that not is implemented is the `netascii` transfer mode. - -## Prerequisites - -It is assumed that the reader is familiar with the Erlang programming language, -concepts of OTP, and has a basic understanding of the TFTP protocol. diff --git a/lib/tftp/src/tftp.erl b/lib/tftp/src/tftp.erl index 985b67a54968..dc2fbf1d53e5 100644 --- a/lib/tftp/src/tftp.erl +++ b/lib/tftp/src/tftp.erl @@ -206,7 +206,7 @@ All options most of them common to the client and server. `write_file/3`. The callback module must implement the `tftp` behavior, see - [CALLBACK FUNCTIONS](`m:tftp#tftp_callback`). + [callbacks](`m:tftp#callbacks`). - **`{logger, module()}`**