Perl - Send files to the HTTP server by request

    In fact, nothing original, the documentation is enough, even more than, although the latter cause very strong anguish. Therefore, it’s easier to practically show once how and what is done, than to read and step on the rake ten times. Condition: There are some binary files that are located locally, there is a server on which we must put these files, on this server there is a script (form handler) that does upload files
    Task: These files need to be added via the web interface (form handler ) to the server, as if we were the browser and sent the data through the form.

    Using LWP :: UserAgent

    The query generation algorithm:
    • Create a request (HTTP :: Request);
    • Create a “browser” (LWP :: UserAgent);
    • We define headers for it;
    • We send a request;
    It’s dreary like XML :: LibXML, but it’s reliable, so: Perl code (1)
    #! / usr / bin / perl
    use strict;
    use warnings;
    use LWP :: UserAgent;
    # This is the file that we will send
    my $ file = './files/some_file.bin';
    # This is the URI by which we will send the request
    my $ uri = 'http://somedomain.com/form/action/script';
    # Request object
    my $ request = HTTP :: Request-> new ('POST', $ uri);
    # We form a separator, because if we do not force it, then with $ ua-> request ($ request) it will not go to the main header
    # although, you can simply make $ request-> as_string after the formation of the header object, then it will be substituted default, but we will not risk
    my $ boundary = 'X';
    my @rand = ('a' .. 'z', 'A' .. 'Z');
    for (0..14) {$ boundary. = $ rand [rand (@rand)];}
    # We form the heading:
    $ request-> header ('Content-Type' => 'multipart / form-data; boundary ='. $ boundary);
    $ request-> header ('User-Agent' => ' Mozilla Firefox 5.0 :-) ');
    $ request-> header ('Referer' => ' http://somedomain.com/form ');
    $ request-> protocol ('HTTP / 1.0'); # Although LWP :: UserAgent will do this, it’s better right away
    # Formation of regular, textual form parameters
    my $ field = HTTP :: Message-> new (
                                    [
                                        'Content-Disposition' => 'form-data; name = " fieldname " ',
                                        'Content-Type' => 'text / plain; charset = utf-8 ',
                                    ]); # The HTTP :: Headers header is substituted during the creation of the HTTP :: Message object
    $ field-> add_content_utf8 (' somevalue '); # Apparently, somevalue should be in UTF-8
    $ request-> add_part ($ field);
    # ... And so on, for each text field ...
    # Formation of binary form parameters
    open (my $ fh, '<', $ file);
    # And you can first make a header, and then apply it to HTTP :: Message
        my $ size = (stat $ file) [7];
        my $ header = HTTP :: Headers-> new;
        $ header-> header ('Content-Disposition' => 'form-data; name = " file "; filename = " somefile.bin '); # Although filename can also be calculated from the file name
        $ header-> header ('Content-Type' => ' application / octet-stream '); # Or appropriate to file type
        my $ file_content = HTTP :: Message-> new ($ header);
        $ file_content-> add_content ($ _) while <$ fh>;
        $ request-> add_part ($ file_content);
    close $ fh;
    # ... And so on, for each file ...
    my $ response = $ ua-> request ($ request);
    if ($ response-> is_success) {
        print $ response-> content
    } else {
        die $ response-> status_line
    }

    Using socket

    Everything would be fine, but if we have a large file for transfer, then uploading it entirely to memory in order to collect the request is not the best prospect. Therefore, it is possible to send a request by stream over a socket: Perl code (2)
    #! / usr / bin / perl
    use strict;
    use warnings;
    use HTTP :: Headers;
    use HTTP :: Message;
    use HTTP :: Request;
    use HTTP :: Response;
    use IO :: Socket :: INET;
    # This is the file that we will send
    my $ file = './files/some_file.bin';
    # This is the URI by which we will send the request
    my $ uri = 'http://somedomain.com/form/action/script';
    # Since we will use a socket, we need a domain, port and path separately
    my ($ domain, $ port, $ path) = $ uri = ~ m / ^ (?: https? \: \ / \ /)? ([^ \ / \:] +) (?: \: (\ d + ))? (. +) $ /;
    $ port || = 80; # Default
    # A bicycle is, of course, good, but you can easily create headers and a non-binary request body with the help of a ready-made module
    my $ header = HTTP :: Headers-> new; $ header-> header ('Content-Type' => 'multipart / form-data');
    my $ request = HTTP :: Request-> new ('POST', $ uri, $ header); # Instead of $ path, we have $ uri, so it should be ;-)
    $ request-> protocol ('HTTP / 1.0'); # It is strange that the protocol does not set HTTP :: Request by default, so we set it ourselves
    # For small amounts of data, for example text fields, a bicycle will also be redundant
    # (SFCI) The conditions are the same as in the previous code (1)
    my $ field = HTTP :: Message-> new (
                                    [
                                        'Content-Disposition' => 'form-data; name = " fieldname " ',
                                        'Content-Type' => 'text / plain; charset = utf-8 ',
                                    ]);
    $ field-> add_content_utf8 (' somevalue '); # And here too utf8
    $ request-> add_part ($ field);
    # ... And so on, for each text field ...
    # Further, our request, but without files, is divided into the main header and the first part of the content
    # We divide the regular expression for $ request-> headers-> as_string does not return the first line of the request, namely, the POST command,
    # But you can collect the string yourself, of course, but laziness.
    my ($ head, $ content) = $ request-> as_string = ~ m / ^ (. +?) \ n \ n (. +) $ / s;
    # Our content is not finished, so we cut it off - [LF] [EOF]
    $ content = substr ($ content, 0, -4);
    # as well as boundary
    $ content = ~ s / (\ - \ - [^ \ n] +) $ // s;
    my $ boundary = $ 1;
    # Read the preliminary request length
    my $ length = length $ content;
    # Now our files:
    my $ files = [];
    my $ size = (stat $ file) [7];
    my $ f_header = HTTP :: Headers-> new;
    $ f_header-> header ('Content-Disposition' => 'form-data; name = " file "; filename = " somefile.bin ');
    $ f_header-> header ('Content-Type' => ' application / octet-stream ');
    $ f_header = $ boundary. "\ n". $ f_header-> as_string. "\ n";
    # We add to the length of the request
    $ length + = length $ f_header;
    $ length + = $ size;
    # Actually, the procedure below is only for cases when there are a lot of files.
    # Then, we first need to calculate the length of the content, because it (long) will be indicated in the main header
    push @ {$ files}, {header => $ f_header, file => $ file};
    # ... And so on, for each file ...
    # So we are done
    $ length + = length $ boundary .'-- '; # We also consider the end line
    # Open socket
    my $ socket = IO :: Socket :: INET-> new ($ domain. ':'. $ port) || die $ !;
    # To the main title is long
    $ head. = "\ nContent-Length:". $ length;
    # Send the header and the first (text) part of the content to the socket
    print $ socket $ head;
    print $ socket "\ n \ n";
    print $ socket $ content;
    foreach my $ file (@ {$ files}) {
        print $ socket $ file -> {header};
        open (my $ fh, '<', $ file -> {file});
        print $ socket $ _ while <$ fh>;
        print $ socket "\ n";
        close $ fh;
    }
    # Send the end of file to the socket
    print $ socket $ boundary .'-- '; 
    # Send the end of file to the socket
    shutdown ($ socket, 1);
    # Get the response from the socket and parse it
    my $ response = HTTP :: Response-> parse (join ('', <$ socket>));
    if ($ response-> is_success) {
        print $ response-> content
    } else {
        die $ response-> status_line
    }
        
    Well done (SFCI) I want to note that everything that is highlighted in italics in the code should be replaced by the corresponding values ​​of the task condition. Note: SFCI - Special for copipaster's idiots. No comments.

    Also popular now: