#	------------------------------------------------------------
#   Copyright (c) 2013-2016
#	Q.W.Page Associates Inc.
#	www.qwpage.com
#	All rights reserved.
#	------------------------------------------------------------
/* {
*/ }
::namespace eval ::qw::tcp {};
::proc ::qw::tcp::packet_send {sargs} {
    /* {
	Usage:
    	::qw::tcp::packet_send .channel $Channel .packet $Packet;

    The packet_send/receive are identical for both a plug and a socket so they
    are used by both.

	Note: we didn't use sargs for the packet itself so that we could add packet
    types.

    */ }
    ::set rwb1_debug 0;
    ::if {$rwb1_debug} {::puts "rwb1_debug,packet_send,1000.0";}
    ::set Packet [::sargs::get $sargs .packet];
    ::if {[::sargs::size $Packet]==0} {
        ::qw::bug 314120170103155823 "[::qw::procname] - no .packet argument.";
    }
    ::if {[::sargs::get $Packet .tcp.command] eq ""} {
        ::qw::bug 314120170103155824 "[::qw::procname] - no .tcp.command in packet.";
    }
    ::if {[::sargs::get $Packet .tcp.source] eq ""} {
        ::qw::bug 314120170103155825 "[::qw::procname] - no .tcp.source in packet.";
    }
    ::if {[::sargs::get $Packet .tcp.destination] eq ""} {
        ::qw::bug 314120170103155826 "[::qw::procname] - no .tcp.destination in packet.";
    }
    ::if {[::sargs::get $Packet .tcp.priority] eq ""} {
        ::qw::bug 314120170103155827 "[::qw::procname] - no .tcp.priority in packet.";
    }
    ::set Channel [::sargs::get $sargs .channel];
    ::if {$Channel eq ""} {
        ::qw::bug 314120170103155828 "[::qw::procname] - no .channel argument.";
    }
    ::if {$rwb1_debug} {::puts "rwb1_debug,packet_send,1000.1";}
	::set Packet [::sargs .packet $Packet];
    ::if {$rwb1_debug} {::puts "rwb1_debug,packet_send,1000.2";}
	::set Packet [::sargs::format .structure $Packet];
#	::set Packet [::sargs::normalize .structure $Packet];
    ::if {$rwb1_debug} {::puts "rwb1_debug,packet_send,1000.3";}
	::puts $Channel $Packet;
    ::if {$rwb1_debug} {::puts "rwb1_debug,packet_send,1000.4";}
	::flush $Channel;
    ::if {$rwb1_debug} {::puts "rwb1_debug,packet_send,1000.5";}
}
::proc ::qw::tcp::packet_receive {sargs} {
    /* {
    Packet is of form .packet $Contents so it should always end with right-brace.
    */ }
    ::set rwb1_debug 0;
    ::if {$rwb1_debug} {::puts "rwb1_debug,packet_receive,1000.0,sargs==$sargs";}
    ::set Channel [::sargs::get $sargs .channel];
    ::if {$Channel eq ""} {
		::qw::bug 314120170103160231 "[::qw::procname] - no .channel argument.";
    }
    ::set Buffer "";
    ::while {1} {
        ::if {[::eof $Channel]} {
		    ::if {$rwb1_debug} {::puts "rwb1_debug,packet_receive,1000.1";}
			/* {
			We get an eof when the other side closes the socket, or when the connection
            goes down. We return an empty packet and the caller can check the connection,
            for example by calling eof.

			2.34.7 - we believe the other side of the connection has gone down.
            Don't know why or care why. Return "". Skip the warning.
            */ }
			/* {
            ::qw::warning [::sargs \
                .text "::qw::tcp::packet_receive - unexpected eof." \
                .warning_id 314120170103145633 \
                .send_warning_to_mothership 1 \
            ];
			*/ }
			::return "";
        }
        ::set Line [::gets $Channel];
        ::if {$rwb1_debug} {::puts "rwb1_debug,packet_receive,1000.2,Line==\"$Line\"";}
        ::append Buffer $Line;
        ::if {[::string index $Line end] eq "\x7d"} {
			/* {
			We use "::info complete" to detect a complete packet but that is an
            expensive call. So we only check when the line ends with a right-brace
            character.
            */ }
	        ::if {$rwb1_debug} {::puts "rwb1_debug,packet_receive,1000.3";}
            ::if {[::info complete $Buffer]} {
		        ::if {$rwb1_debug} {::puts "rwb1_debug,packet_receive,1000.4";}
                ::if {[::lindex $Buffer 0] ne ".packet"} {
                    ::if {$rwb1_debug} {::puts "rwb1_debug,packet_receive,1000.4.0,Buffer==\n$Buffer";}
					# 20210209 - 26 occurences in mdb
					# changed bug to a warning
                    ::qw::warning [::sargs \
                        .text "::qw::tcp::packet_receive - no .packet field." \
                        .warning_id 314120170103145632 \
                        .send_warning_to_mothership 1 \
                    ];
					::return "";
                    # 2.34.7 ::qw::bug 314120170103145632 "[::qw::procname] - bad packet received.";
                }
		        ::if {$rwb1_debug} {::puts "rwb1_debug,packet_receive,1000.5";}
                ::return [::sargs::get $Buffer .packet];
            }
        }
    }
    ::qw::warning [::sargs \
        .text "::qw::tcp::packet_receive - incomplete packet received." \
        .warning_id 314120170103145633 \
        .send_warning_to_mothership 1 \
    ];
	::if {$rwb1_debug} {::puts "rwb1_debug,packet_receive,1000.6";}
	# 20210209 - this bug never received in message_database
    #::qw::bug 314120170103145633 "[::qw::procname] - incomplete packet received.";
}
::set ::qw::tcp::dump_tls_status_count 0;

::proc ::qw::tcp::dump_tls_status {sargs} {
    /* {
    We only dump it once because we can't get the real status until after
    handshake and after a message is sent.
    */ }
    /* {
    After upgraded and used we get:

    ::tls::status[sbits]=="256"
    ::tls::status[cipher]=="DHE-RSA-AES256-SHA"

    */ }
    ::set Limit [::sargs::integer_get $sargs .limit]
    ::if {$Limit ne 0&&$::qw::tcp::dump_tls_status_count>=$Limit} {
		/* {
		We only want this info dumped once but it seems we have to dump it
        after send/receiving packets so the call may be in a frequently used
        method.
        */ }
        ::return;
    }
	::puts "tls package version==[::package require tls];"
	::puts "OpenSSL version==[::tls::version]";
    ::set Channel [::sargs::get $sargs .channel]
    ::if {$Channel eq ""} {
		::return;
    }
    ::set StatusList [::list];
    ::qw::try {
        ::set StatusList [::tls::status $Channel];
    } catch dummy {
        ::return;
    }
    ::incr ::qw::tcp::dump_tls_status_count;
    ::puts "status list ----- ------------------------------------------------------";
    ::foreach {Name Value} $StatusList {
        ::puts "[::info nameofexecutable],::tls::status\[$Name\]==\"$Value\"";
    }
    ::puts "tls1 cipher_list -------------------------------------------------------";
    ::set Count 0;
    ::foreach Item [::tls::ciphers tls1 1] {
        ::puts "[::info nameofexecutable],tls1,ciphers\[$Count\]==\"$Item\".";
        ::incr Count;
    }
    ::puts "ssl2 cipher_list -------------------------------------------------------";
}
::proc ::qw::tcp::tls_socket_upgrade {sargs} {
	::if {!$::qw::control(tcp_tls_is_enabled)} {
    	::qw::bug 314120150309120901 "[::qw::methodname] - invalid tls control flag.";
    }
    ::set rwb1_debug 0;
    ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::tcp::tls_socket_upgrade,1000.0,tls::version==[::tls::version]";}
    /* {
    Don't know why we need the key files when we never actually use
    the keys.

    Experiment: Copied the public and private key files into the vfs
    and tried to access them directly from the vfs in the nv2.exe.
    Crashed and burned. So we are instead going to copy the files
    into the nv2.dat/qw_reg. 20201110 -> verified in 8.4 and 8.6

	---------------------------------------------------------------
	server-public2048.pem 1338 -> 314120140923164938 CERTIFICATE
    server-private2048.pem 887 -> 314120140923164939 RSA PRIVATE KEY

	https-certificate.pem 952 -> nv2.dat/cert/314120201110144037.pem CERTIFICATE
	https-certificate.pem 952 -> nv2.dat/cert/314120201110144038.pem CERTIFICATE
	https-private.key 1704 -> nv2.dat/cert/314120201110144039.key - PRIVATE KEY

	server-public4096.pem 1785  -> 314120240311165631 - CERTIFICATE
	server-private4096.key 3243  -> 314120240311165632 - PRIVATE KEY

	server-public4096.pem 1785  -> nv2.dat/cert/314120250311110912.pem CERTIFICATE
	server-public4096.pem 1785  -> nv2.dat/cert/314120250311110913.pem CERTIFICATE
	server-private4096.key 3243  -> nv2.dat/cert/314120250311110914.key RSA PRIVATE KEY

			::set CertFolder [::file join $::qw_program_folder nv2.dat nv2_cert];
			::qw::fileutil::mkdir .path $CertFolder;
			::set CAFile [::file join $CertFolder 314120250311110912.pem];
			::if {![::file exists $CAFile]} {
				::file copy [::file join $::qw_program_path system tcp server-public4096.pem] $CAFile;
			}
			::set CertFile [::file join $CertFolder 314120250311110913.pem];
			::if {![::file exists $CertFile]} {
				::file copy [::file join $::qw_program_path system tcp server-public4096.pem] $CertFile;
			}
			::set KeyFile [::file join $CertFolder 314120250311110914.key];
			::if {![::file exists $KeyFile]} {
				::file copy [::file join $::qw_program_path system tcp server-private4096.key] $KeyFile;
			}


			::set CAFile [::file join $CertFolder 314120201110144037.pem];
			::if {![::file exists $CAFile]} {
				::file copy [::file join $::qw_program_path system tcp https_certificate.pem] $CAFile;
			}
			::set CertFile [::file join $CertFolder 314120201110144038.pem];
			::if {![::file exists $CertFile]} {
				::file copy [::file join $::qw_program_path system tcp https_certificate.pem] $CertFile;
			}
			::set KeyFile [::file join $CertFolder 314120201110144039.key];
			::if {![::file exists $KeyFile]} {
				::file copy [::file join $::qw_program_path system tcp https_private.key] $KeyFile;
			}







    */ }
	::if {!$::qw::control(ssl_key_generate)} {
        #rwb__debug, if this works, delete these files if they exists
		# 2.35.8 - changed cert file folder from qw_program_folder to .../nv2.dat/nv2_cert
#        ::set CertFile [::file join $::qw_program_folder 314120140923164938];
#        ::set KeyFile [::file join $::qw_program_folder 314120140923164939];
		::if {$::qw::control(ssl_use_openssl_key)} {
	        ::set CertFile [::file join $::qw_program_folder nv2.dat nv2_cert 314120250331105402.crt];
    	    ::set KeyFile [::file join $::qw_program_folder nv2.dat nv2_cert 314120250331105402.key];
            ::if {![::file exists $CertFile]} {
                # CertFile is a signed public key.
                ::file mkdir [::file join $::qw_program_folder nv2.dat nv2_cert];
                ::file copy [::file join $::qw_program_path system tcp 314120250331105402.crt] $CertFile;
            }
            ::if {![::file exists $KeyFile]} {
                ::file mkdir [::file join $::qw_program_folder nv2.dat nv2_cert];
                ::file copy [::file join $::qw_program_path system tcp 314120250331105402.key] $KeyFile;
            }
		}
		::if {!$::qw::control(ssl_use_openssl_key)} {
	        ::set CertFile [::file join $::qw_program_folder nv2.dat nv2_cert 314120140923164938];
    	    ::set KeyFile [::file join $::qw_program_folder nv2.dat nv2_cert 314120140923164939];
            ::if {![::file exists $CertFile]} {
                # CertFile is a signed public key.
                ::file mkdir [::file join $::qw_program_folder nv2.dat nv2_cert];
                ::file copy [::file join $::qw_program_path system tcp server-public2048.pem] $CertFile;
            }
            ::if {![::file exists $KeyFile]} {
                ::file mkdir [::file join $::qw_program_folder nv2.dat nv2_cert];
                ::file copy [::file join $::qw_program_path system tcp server-private2048.pem] $KeyFile;
            }
		}

	}
	::set Channel [::sargs::get $sargs .channel];
	::if {$::qw::control(ssl_key_generate)} {
		::qw::tcp::tls_generate_self_signed_certificate;
		::set CertFile $::qw::tcp::tls_cert_path;
		::set KeyFile $::qw::tcp::tls_key_path;
	}
    #::fconfigure $Channel -buffering line -translation auto;
	::qw::try {
        ::tls::import $Channel \
            -server 1 \
            -certfile $CertFile \
            -keyfile  $KeyFile \
            -ssl2 0 \
            -ssl3 0 \
            -tls1 1 \
            -require 0 \
            -request 0 \
        ;
	} catch Exception {
		/* {
		If this doesn't succeed we may as well call it a bug because we're
        in real trouble and we crash later enyway with bug_id 314120050418084921.
        */ }
		::if {$::qw::verbose(Exception)} {
			::puts "314120250320114245,CertFile==$Certfile";
			::puts "314120250320114245,KeyFile==$KeyFile";
			::puts "314120250320114245,exception==$Exception";
		}
		throw BUG("314120250320114245","Can't create certificate,exception=="+Exception.quote());


    }
    ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::tcp::socket::tls_socket_upgrade,1000.3";}
}
::proc ::qw::tcp::tls_plug_upgrade {sargs} {
	::if {!$::qw::control(tcp_tls_is_enabled)} {
    	::qw::bug 314120150309120903 "[::qw::methodname] - invalid tls control flag.";
    }
    ::set rwb1_debug 0;
    ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::tcp::tls_plug_upgrade,1000.2";}
	::set Channel [::sargs::get $sargs .channel];
    ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::tcp::tls_plug_upgrade::tls_upgrade,1000.1";}
    #::fconfigure $Channel -buffering line -translation auto;
    ::tls::import $Channel \
        -ssl2 0 \
        -ssl3 0 \
        -tls1 1 \
        -require 0 \
        -request 0 \
    ;
    ::if {$rwb1_debug} {
        ::foreach {Name Value} [::tls::status $Channel] {
            ::puts "::rwb1_debug,after1,::tls::status\[$Name\]==\"$Value\"";
        }
        /* {
        ::tls::status[sbits]=="0"
        */ }
    }
    ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::tcp::tls_plug_upgrade::phase2_tls_upgrade,1000.4";}
	::qw::try {
	    ::tls::handshake $Channel;
	} catch Exception {
		::qw::throw $Exception;
    }
    ::if {$rwb1_debug} {
        ::qw::tcp::dump_tls_status .channel $Channel .limit 1;
    }
    ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::tcp::plug::tls_plug_upgrade,1000.5";}
}
::set ::qw::tcp::tls_certificates_were_created 0;
::set ::qw::tcp::tls_key_path [::file join $::qw_program_folder nv2.dat nv2_cert 314120250317180704.key];
::set ::qw::tcp::tls_cert_path [::file join $::qw_program_folder nv2.dat nv2_cert 314120250317180704.pem];
::set ::qw::tcp::tls_key_size 2048;
::proc ::qw::tcp::tls_generate_self_signed_certificate {sargs} {
    /* {
    From tcl 8.5 network programming page 500

    The tcl package apparently has the ability to easily generate a self-signed
    certificate but not the ability to use it to sign other certificates.
    Here we just test the tcl self-sign ability and it works.

	Call this at runtime from a -server or service.
    */ }
#		::set _main_folder [::file join c:/ rwb_wip ssl_certificate_test];

	::set rwb1_debug 0;
	::if {!$::qw::control(ssl_key_generate)} {
		::qw::bug 312120250318093148 "[::qw::procname] - ssl_key_generate not enabled.";
    }
	::if {$::qw::tcp::tls_certificates_were_created} {
		::return;
    }
	::if {$rwb1_debug} {::puts "rwb1_debug,generate_self_signed_certificate,1000.0,::qw::tcp::tls_cert_path==$::qw::tcp::tls_cert_path";}
	::qw::fileutil::mkdir .path [::file dirname $::qw::tcp::tls_cert_path];
	::if {$rwb1_debug} {::puts "rwb1_debug,generate_self_signed_certificate,1000.1";}
	::file delete $::qw::tcp::tls_key_path;
	::if {$rwb1_debug} {::puts "rwb1_debug,generate_self_signed_certificate,1000.2";}
    ::file delete $::qw::tcp::tls_cert_path;
	::if {$rwb1_debug} {::puts "rwb1_debug,generate_self_signed_certificate,1000.3";}
    ::tls::misc req \
		$::qw::tcp::tls_key_size \
    	$::qw::tcp::tls_key_path \
        $::qw::tcp::tls_cert_path \
        [::list \
            CN "www.qwpage.com" \
            days [::expr {365*1}] \
            C CA \
            ST Ontario \
            L Aurora \
            O "Q.W.Page Associates Inc." \
            OU "NewViews" \
            Email "benn@qwpage.com" \
	    ] \
    ;
	::if {0} { # tried this but didn't make any difference
    ::tls::init \
        -certfile $::qw::tcp::tls_cert_path \
        -keyfile $::qw::tcp::tls_key_path \
        -ssl2 0 \
        -ssl3 0 \
        -tls1 1 \
        -require 0 \
        -request 0 \
    ;
	}
	::if {0} {
		::if {$rwb1_debug} {::puts "rwb1_debug,generate_self_signed_certificate,1000.4";}
    	::qw::tcp::tls_dump_certificate .path $::qw::tcp::tls_cert_path;
		::if {$rwb1_debug} {::puts "rwb1_debug,generate_self_signed_certificate,1000.5";}
    	::qw::tcp::tls_dump_certificate .path $::qw::tcp::tls_key_path;
		::if {$rwb1_debug} {::puts "rwb1_debug,generate_self_signed_certificate,1000.6";}
    }
	::set ::qw::tcp::tls_certificates_were_created 1;
    ::if {$rwb1_debug} {::puts "rwb1_debug,generate_self_signed_certificate,1000.7";}
}
::proc ::qw::tcp::tls_dump_certificate {sargs} {
    /* {
    Command from openssl page 309
    */ }
    ::set Path [::sargs::get $sargs .path];
    ::tls::misc asn1parse \
        -inform PEM \
        -in $Path \
        -out [::file join [::file rootname $Path].txt] \
        -i \
        -dump \
        "2>[::file join [::file rootname $Path].txt]" \
    ;
}