Mercurial > urweb

comparison src/postgres.sml @ 2177:00cf8214c2e3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Switching to a more dynamic method of handling database reconnection, restarting transactions
author Adam Chlipala <adam@chlipala.net>
date Sat, 17 Oct 2015 11:08:12 -0400
parents d2a98983f502
children 251dd276f45f
comparison
equal deleted inserted replaced
2176:d2a98983f502 2177:00cf8214c2e3
1 (* Copyright (c) 2008-2010, 2015, Adam Chlipala 1 (* Copyright (c) 2008-2010, Adam Chlipala
2 * All rights reserved. 2 * All rights reserved.
3 * 3 *
4 * Redistribution and use in source and binary forms, with or without 4 * Redistribution and use in source and binary forms, with or without
5 * modification, are permitted provided that the following conditions are met: 5 * modification, are permitted provided that the following conditions are met:
6 * 6 *
518 newline, 518 newline,
519 string "msg[1023] = 0;", 519 string "msg[1023] = 0;",
520 newline, 520 newline,
521 string "PQfinish(conn);", 521 string "PQfinish(conn);",
522 newline, 522 newline,
523 string "uw_error(ctx, FATAL, ", 523 string "uw_error(ctx, BOUNDED_RETRY, ",
524 string "\"Connection to Postgres server failed: %s\", msg);"], 524 string "\"Connection to Postgres server failed: %s\", msg);"],
525 newline, 525 newline,
526 string "}", 526 string "}",
527 newline, 527 newline,
528 string "uw_set_db(ctx, conn);", 528 string "uw_set_db(ctx, conn);",
610 string ")"] 610 string ")"]
611 in 611 in
612 getter t 612 getter t
613 end 613 end
614 614
615 fun queryCommon {loc, query, cols, doCols, runit} = 615 fun queryCommon {loc, query, cols, doCols} =
616 box [string "int n, i;", 616 box [string "int n, i;",
617 newline, 617 newline,
618 newline, 618 newline,
619 619
620 string "if (res == NULL) {", 620 string "if (res == NULL) {",
621 box [newline, 621 box [newline,
622 string "if (uw_try_reconnecting_if_at_most_one(ctx)) {", 622 string "uw_try_reconnecting_and_restarting(ctx);",
623 box [newline, 623 newline,
624 string "conn = uw_get_db(ctx);", 624 string "uw_error(ctx, FATAL, \"Can't allocate query result; database server may be down.\");",
625 newline,
626 runit,
627 newline],
628 string "}",
629 newline,
630 string "if (res == NULL) uw_error(ctx, FATAL, \"Can't allocate query result; database server might be down.\");",
631 newline], 625 newline],
632 string "}", 626 string "}",
633 newline, 627 newline,
634 newline, 628 newline,
635 629
697 newline, 691 newline,
698 string "uw_pop_cleanup(ctx);", 692 string "uw_pop_cleanup(ctx);",
699 newline] 693 newline]
700 694
701 fun query {loc, cols, doCols} = 695 fun query {loc, cols, doCols} =
702 let 696 box [string "PGconn *conn = uw_get_db(ctx);",
703 val runit = string "res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);" 697 newline,
704 in 698 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
705 box [string "PGconn *conn = uw_get_db(ctx);", 699 newline,
706 newline, 700 newline,
707 string "PGresult *res;", 701 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}]
708 newline,
709 runit,
710 newline,
711 newline,
712 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query", runit = runit}]
713 end
714 702
715 fun p_ensql t e = 703 fun p_ensql t e =
716 case t of 704 case t of
717 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"] 705 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
718 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"] 706 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
772 newline]) 760 newline])
773 inputs, 761 inputs,
774 newline] 762 newline]
775 763
776 fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} = 764 fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} =
777 let 765 box [string "PGconn *conn = uw_get_db(ctx);",
778 val runit = 766 newline,
779 box [string "res = ", 767
780 if #persistent (Settings.currentProtocol ()) then 768 makeParams inputs,
781 box [string "PQexecPrepared(conn, \"uw", 769
782 string (Int.toString id), 770 newline,
783 string "\", ", 771 string "PGresult *res = ",
784 string (Int.toString (length inputs)), 772 if #persistent (Settings.currentProtocol ()) then
785 string ", paramValues, paramLengths, paramFormats, 0);"] 773 box [string "PQexecPrepared(conn, \"uw",
786 else 774 string (Int.toString id),
787 box [string "PQexecParams(conn, \"", 775 string "\", ",
788 string (Prim.toCString query), 776 string (Int.toString (length inputs)),
789 string "\", ", 777 string ", paramValues, paramLengths, paramFormats, 0);"]
790 string (Int.toString (length inputs)), 778 else
791 string ", NULL, paramValues, paramLengths, paramFormats, 0);"]] 779 box [string "PQexecParams(conn, \"",
792 in 780 string (Prim.toCString query),
793 box [string "PGconn *conn = uw_get_db(ctx);", 781 string "\", ",
794 newline, 782 string (Int.toString (length inputs)),
795 783 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
796 makeParams inputs, 784 newline,
797 785 newline,
798 newline, 786 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
799 string "PGresult *res;", 787 string (Prim.toCString query),
800 runit, 788 string "\""]}]
801 newline, 789
802 newline, 790 fun dmlCommon {loc, dml, mode} =
803 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
804 string (Prim.toCString query),
805 string "\""],
806 runit = runit}]
807 end
808
809 fun dmlCommon {loc, dml, mode, runit} =
810 box [string "if (res == NULL) {", 791 box [string "if (res == NULL) {",
811 box [newline, 792 box [newline,
812 string "if (uw_try_reconnecting_if_at_most_one(ctx)) {", 793 string "uw_try_reconnecting_and_restarting(ctx);",
813 box [newline, 794 newline,
814 string "conn = uw_get_db(ctx);", 795 string "uw_error(ctx, FATAL, \"Can't allocate DML result; database server may be down.\");",
815 newline,
816 runit,
817 newline],
818 string "}",
819 newline,
820 string "if (res == NULL) uw_error(ctx, FATAL, \"Can't allocate DML result; database server might be down.\");",
821 newline], 796 newline],
822 string "}", 797 string "}",
823 newline, 798 newline,
824 newline, 799 newline,
825 800
855 830
856 string "res = PQexec(conn, \"ROLLBACK TO s\");", 831 string "res = PQexec(conn, \"ROLLBACK TO s\");",
857 newline, 832 newline,
858 string "if (res == NULL) {", 833 string "if (res == NULL) {",
859 box [newline, 834 box [newline,
860 string "uw_error(ctx, FATAL, \"Can't allocate DML ROLLBACK result; database server might be down.\");", 835 string "uw_try_reconnecting_and_restarting(ctx);",
836 newline,
837 string "uw_error(ctx, FATAL, \"Can't allocate DML ROLLBACK result; database server may be down.\");",
861 newline], 838 newline],
862 string "}", 839 string "}",
863 newline, 840 newline,
864 newline, 841 newline,
865 842
890 newline, 867 newline,
891 box [string "PQclear(res);", 868 box [string "PQclear(res);",
892 newline, 869 newline,
893 string "res = PQexec(conn, \"RELEASE s\");", 870 string "res = PQexec(conn, \"RELEASE s\");",
894 newline, 871 newline,
895 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML RELEASE result.\");", 872 string "if (res == NULL) {",
873 box [newline,
874 string "uw_try_reconnecting_and_restarting(ctx);",
875 newline,
876 string "uw_error(ctx, FATAL, \"Can't allocate DML RELEASE result; database server may be down.\");",
877 newline],
878 string "}",
896 newline, 879 newline,
897 newline, 880 newline,
898 881
899 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", 882 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
900 newline, 883 newline,
916 fun makeSavepoint mode = 899 fun makeSavepoint mode =
917 case mode of 900 case mode of
918 Error => box [] 901 Error => box []
919 | None => box [string "res = PQexec(conn, \"SAVEPOINT s\");", 902 | None => box [string "res = PQexec(conn, \"SAVEPOINT s\");",
920 newline, 903 newline,
921 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML SAVEPOINT result.\");", 904 string "if (res == NULL) {",
905 box [newline,
906 string "uw_try_reconnecting_and_restarting(ctx);",
907 newline,
908 string "uw_error(ctx, FATAL, \"Can't allocate DML SAVEPOINT result; database server may be down.\");",
909 newline],
910 string "}",
922 newline, 911 newline,
923 newline, 912 newline,
924 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", 913 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
925 box [newline, 914 box [newline,
926 string "PQclear(res);", 915 string "PQclear(res);",
932 string "PQclear(res);", 921 string "PQclear(res);",
933 newline, 922 newline,
934 newline] 923 newline]
935 924
936 fun dml (loc, mode) = 925 fun dml (loc, mode) =
937 let 926 box [string "PGconn *conn = uw_get_db(ctx);",
938 val runit = string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);" 927 newline,
939 in 928 string "PGresult *res;",
940 box [string "PGconn *conn = uw_get_db(ctx);", 929 newline,
941 newline, 930
942 string "PGresult *res;", 931 makeSavepoint mode,
943 newline, 932
944 933 string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);",
945 makeSavepoint mode, 934 newline,
946 935 newline,
947 runit, 936 dmlCommon {loc = loc, dml = string "dml", mode = mode}]
948 newline,
949 newline,
950 dmlCommon {loc = loc, dml = string "dml", mode = mode, runit = runit}]
951 end
952 937
953 fun dmlPrepared {loc, id, dml, inputs, mode} = 938 fun dmlPrepared {loc, id, dml, inputs, mode} =
954 let 939 box [string "PGconn *conn = uw_get_db(ctx);",
955 val runit = 940 newline,
956 box [string "res = ", 941
957 if #persistent (Settings.currentProtocol ()) then 942 makeParams inputs,
958 box [string "PQexecPrepared(conn, \"uw", 943
959 string (Int.toString id), 944 newline,
960 string "\", ", 945 string "PGresult *res;",
961 string (Int.toString (length inputs)), 946 newline,
962 string ", paramValues, paramLengths, paramFormats, 0);"] 947 newline,
963 else 948
964 box [string "PQexecParams(conn, \"", 949 makeSavepoint mode,
965 string (Prim.toCString dml), 950
966 string "\", ", 951 string "res = ",
967 string (Int.toString (length inputs)), 952 if #persistent (Settings.currentProtocol ()) then
968 string ", NULL, paramValues, paramLengths, paramFormats, 0);"]] 953 box [string "PQexecPrepared(conn, \"uw",
969 in 954 string (Int.toString id),
970 box [string "PGconn *conn = uw_get_db(ctx);", 955 string "\", ",
971 newline, 956 string (Int.toString (length inputs)),
972 957 string ", paramValues, paramLengths, paramFormats, 0);"]
973 makeParams inputs, 958 else
974 959 box [string "PQexecParams(conn, \"",
975 newline, 960 string (Prim.toCString dml),
976 string "PGresult *res;", 961 string "\", ",
977 newline, 962 string (Int.toString (length inputs)),
978 newline, 963 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
979 964 newline,
980 makeSavepoint mode, 965 newline,
981 966 dmlCommon {loc = loc, dml = box [string "\"",
982 runit, 967 string (Prim.toCString dml),
983 newline, 968 string "\""], mode = mode}]
984 newline, 969
985 dmlCommon {loc = loc, dml = box [string "\"", 970 fun nextvalCommon {loc, query} =
986 string (Prim.toCString dml),
987 string "\""], mode = mode, runit = runit}]
988 end
989
990 fun nextvalCommon {loc, query, runit} =
991 box [string "if (res == NULL) {", 971 box [string "if (res == NULL) {",
992 box [newline, 972 box [newline,
993 string "if (uw_try_reconnecting_if_at_most_one(ctx))", 973 string "uw_try_reconnecting_and_restarting(ctx);",
994 newline, 974 newline,
995 string "conn = uw_get_db(ctx);", 975 string "uw_error(ctx, FATAL, \"Can't allocate NEXTVAL result; database server may be down.\");",
996 newline,
997 runit,
998 newline,
999 string "uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");",
1000 newline], 976 newline],
1001 string "}", 977 string "}",
1002 newline, 978 newline,
1003 newline, 979 newline,
1004 980
1045 SOME s => 1021 SOME s =>
1046 string ("\"SELECT NEXTVAL('" ^ s ^ "')\"") 1022 string ("\"SELECT NEXTVAL('" ^ s ^ "')\"")
1047 | _ => box [string "uw_Basis_strcat(ctx, \"SELECT NEXTVAL('\", uw_Basis_strcat(ctx, ", 1023 | _ => box [string "uw_Basis_strcat(ctx, \"SELECT NEXTVAL('\", uw_Basis_strcat(ctx, ",
1048 seqE, 1024 seqE,
1049 string ", \"')\"))"] 1025 string ", \"')\"))"]
1050
1051 val runit = string "res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);"
1052 in 1026 in
1053 box [string "char *query = ", 1027 box [string "char *query = ",
1054 query, 1028 query,
1055 string ";", 1029 string ";",
1056 newline, 1030 newline,
1057 string "PGconn *conn = uw_get_db(ctx);", 1031 string "PGconn *conn = uw_get_db(ctx);",
1058 newline, 1032 newline,
1059 string "PGresult *res;", 1033 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
1060 newline, 1034 newline,
1061 runit, 1035 newline,
1062 newline, 1036 nextvalCommon {loc = loc, query = string "query"}]
1063 newline,
1064 nextvalCommon {loc = loc, query = string "query", runit = runit}]
1065 end 1037 end
1066 1038
1067 fun nextvalPrepared {loc, id, query} = 1039 fun nextvalPrepared {loc, id, query} =
1068 let 1040 box [string "PGconn *conn = uw_get_db(ctx);",
1069 val runit = 1041 newline,
1070 box [string "res = ", 1042 newline,
1071 if #persistent (Settings.currentProtocol ()) then 1043 string "PGresult *res = ",
1072 box [string "PQexecPrepared(conn, \"uw", 1044 if #persistent (Settings.currentProtocol ()) then
1073 string (Int.toString id), 1045 box [string "PQexecPrepared(conn, \"uw",
1074 string "\", 0, NULL, NULL, NULL, 0);"] 1046 string (Int.toString id),
1075 else 1047 string "\", 0, NULL, NULL, NULL, 0);"]
1076 box [string "PQexecParams(conn, \"", 1048 else
1077 string (Prim.toCString query), 1049 box [string "PQexecParams(conn, \"",
1078 string "\", 0, NULL, NULL, NULL, NULL, 0);"]] 1050 string (Prim.toCString query),
1079 in 1051 string "\", 0, NULL, NULL, NULL, NULL, 0);"],
1080 box [string "PGconn *conn = uw_get_db(ctx);", 1052 newline,
1081 newline, 1053 newline,
1082 newline, 1054 nextvalCommon {loc = loc, query = box [string "\"",
1083 1055 string (Prim.toCString query),
1084 string "PGresult *res;", 1056 string "\""]}]
1085 newline, 1057
1086 runit, 1058 fun setvalCommon {loc, query} =
1087 newline,
1088 newline,
1089 nextvalCommon {loc = loc, query = box [string "\"",
1090 string (Prim.toCString query),
1091 string "\""], runit = runit}]
1092 end
1093
1094 fun setvalCommon {loc, query, runit} =
1095 box [string "if (res == NULL) {", 1059 box [string "if (res == NULL) {",
1096 box [newline, 1060 box [newline,
1097 string "if (uw_try_reconnecting_if_at_most_one(ctx))", 1061 string "uw_try_reconnecting_and_restarting(ctx);",
1098 newline, 1062 newline,
1099 string "conn = uw_get_db(ctx);", 1063 string "uw_error(ctx, FATAL, \"Can't allocate SETVAL result; database server may be down.\");",
1100 newline,
1101 runit,
1102 newline,
1103 string "uw_error(ctx, FATAL, \"Out of memory allocating setval result.\");",
1104 newline], 1064 newline],
1105 string "}", 1065 string "}",
1106 newline, 1066 newline,
1107 newline, 1067 newline,
1108 1068
1128 val query = box [string "uw_Basis_strcat(ctx, \"SELECT SETVAL('\", uw_Basis_strcat(ctx, ", 1088 val query = box [string "uw_Basis_strcat(ctx, \"SELECT SETVAL('\", uw_Basis_strcat(ctx, ",
1129 seqE, 1089 seqE,
1130 string ", uw_Basis_strcat(ctx, \"', \", uw_Basis_strcat(ctx, uw_Basis_sqlifyInt(ctx, ", 1090 string ", uw_Basis_strcat(ctx, \"', \", uw_Basis_strcat(ctx, uw_Basis_sqlifyInt(ctx, ",
1131 count, 1091 count,
1132 string "), \")\"))))"] 1092 string "), \")\"))))"]
1133
1134 val runit = string "res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);"
1135 in 1093 in
1136 box [string "char *query = ", 1094 box [string "char *query = ",
1137 query, 1095 query,
1138 string ";", 1096 string ";",
1139 newline, 1097 newline,
1140 string "PGconn *conn = uw_get_db(ctx);", 1098 string "PGconn *conn = uw_get_db(ctx);",
1141 newline, 1099 newline,
1142 1100 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
1143 string "PGresult *res;", 1101 newline,
1144 newline, 1102 newline,
1145 runit, 1103 setvalCommon {loc = loc, query = string "query"}]
1146 newline,
1147 newline,
1148 setvalCommon {loc = loc, query = string "query", runit = runit}]
1149 end 1104 end
1150 1105
1151 fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'" 1106 fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'"
1152 | #"\\" => "\\\\" 1107 | #"\\" => "\\\\"
1153 | ch => 1108 | ch =>